ユーザーフォームの作成


「データ入力」のスイッチと「データ修正」のスイッチがあるユーザーフォームの作成




データを表示させるユーザーフォームの作成




コントロール IMEModeプロパティー
名前、住所、備考 fmIMEModeOn 1 IME をオンにします。
フリガナ fmIMEModeKatakanaHalf 6 半角カタカナ モードで IME をオンにします。
電話番号 fmIMEModeOff 2 IME をオフにして英語モードにします。




全体の流れ
〇顧客管理マクロを実行するとMainFormが立ち上がる。
〇データ入力をクリックすると、入力画面が表示される。
〇内容を書き込み入力をクリックすると、内容が追加される。そして、名前による昇順が実行される。
〇データ修正をクリックすると、修正画面が表示される。名前のところがComboBoxになっていて、名前を選択すると内容が表示される。表示された内容を修正して修正入力をクリックすると、内容が書き換えられる。


コードの記述

<MainForm内のコード>
MainFormを表示させる
Sub 顧客管理()
MainForm.Show
End Sub

MainFormを表示する。
データ入力をクリックした時に、データ入力用のDateFormが表示されるようする
Private Sub NewButton_Click()
With DataForm
.Caption = "データ入力"
.NyuryokuButton.Caption = "入力"
.NyuryokuButton.Visible = True

With .ComboBox1
.Style = fmStyleDropDownCombo
.ShowDropButtonWhen = fmShowDropButtonWhenNever

End With
.Show
End With
End Sub
データ入力をクリックした時に作動するプロシージャ
WithステートメントでDataFormを指定する。
DataFormのCaptionを「データ入力」とする。
DataFormのNyuryokuButtonのCaptionを「入力」にする。
DataFormのNyuryokuButtonを表示する。

WithステートメントでDataFormのComboBox1を指定する。
ComboBox1のStyleをfmStyleDropDownComboにする。
ComboBox1のShowDropButtonWhen
をfmShowDropButtonWhenNeverにする。
Withステートメントの終了。
DataFormを表示する。
Withステートメントの終了。
プロシージャの終了。
fmStyleDropDownComboの意味
コンボ ボックス (ComboBox) コントロールは、選択項目のリストを持つコンボ ボックスとして機能します。編集領域に値を入力したり、選択項目のリストから値を選択することができます。
fmShowDropButtonWhenNeverの意味
コントロールの右端の下向き矢印は、どの状況下でも表示しません。

データ修正をクリックした時に、データ修正入力用のDataFormを表示させる
Private Sub ShuseiButton_Click()
With DataForm
.Caption = "データ修正"
.NyuryokuButton.Caption = "修正入力"
.NyuryokuButton.Visible = True

With .ComboBox1
.Style = fmStyleDropDownCombo
.ShowDropButtonWhen = fmShowDropButtonWhenAlways
End With
Call NameList
.Show
End With
End Sub
データ修正ボタンをクリックした時に作動するプロシージャ
WithステートメントでDataFormを指定する。
DataFormのCaptionを「データ修正」とする。
DataFormのNyuryokuButtonのCaptionを「修正入力」にする。
DataFormのNyuryokuButtonを表示する。
WithステートメントでDataFormのComboBox1を指定する。ComboBox1のStyleをfmStyleDropDownComboにする。
ComboBox1のShowDropButtonWhen
をfmShowDropButtonWhenAlwaysにする。
Withステートメントの終了。
Listというプロシージャを呼び出す。
DataFormを表示する。
Withステートメントの終了。
プロシージャの終了。
fmShowDropButtonWhenAlwaysの意味
コントロールの右端の下向き矢印を常に表示します。

終了ボタンの処理
Private Sub OwariButton_Click()
Unload Me
End
End Sub
終了ボタンをクリックした時に作動するプロシージャ

ComboBox1に名前を追加する
Sub NameList()
For Each namedata In _ Worksheets("Sheet1").Range("A:A")
If namedata.Value <> "" Then
DataForm.ComboBox1.AddItem namedata.Value
Else
Exit Sub
End If
Next
End Sub
ComboBox1に名前を追加するプロシージャ
RangeAの各行について、
空白になるまで、
名前を追加する。
プロシージャの終了。

For Each...Next ステートメントの使い方

For Each...Next ステートメントは、コレクションの各オブジェクトまたは配列の各要素に対して、一連のステートメントブロックを繰り返し実行します。Visual Basicでは、ループを実行するごとに、自動的に変数を設定します。たとえば、次のプロシージャは、実行中のプロシージャに含まれるフォームを除き、すべてのフォームを閉じます。

Sub CloseForms()
For Each frm In Application.Forms
If frm.Caption <> Screen. ActiveForm.Caption Then _
frm.Close Next
End Sub

次のコードは、配列の各要素をループし、各要素の値をインデックス変数 I に設定します。

Dim TestArray(10) As Integer, I As Variant
For Each I In TestArray TestArray(I) = I Next I

セルの範囲内でのループの実行 For Each...Next ループを使って指定した範囲のセルをループします。
次のプロシージャは、Sheet1 の A1:D10 の範囲でループを実行し、絶対値が 0.01 より小さい数値を 0 に設定します。

Sub RoundToZero()
For Each myObject in myCollection
If Abs(myObject.Value) < 0.01 Then myObject.Value = 0 Next
End Sub

For Each...Next ループの終了
For Each...Next ステートメントを終了するには、Exit For ステートメントを使います。たとえば、エラーが発生する場合、特定のエラーを調べるために、If...Then...Else ステートメントまたは Select Case ステートメントの真 (True) ステートメント ブロック中で Exit For ステートメントを使います。エラーが発生せず、If...Then...Else ステートメントが偽 (False) の場合、ループは通常どおりに続行されます。
次の例は、セル範囲 A1:B5 で数値を含まないセルがあるかどうかを調べます。そのようなセルが見つかるとメッセージが表示され、Exit For ステートメントによってループが終了します。

Sub TestForNumbers()
For Each myObject In MyCollection
If IsNumeric(myObject.Value) = False Then
MsgBox "オブジェクトに数値以外の値が含まれています。"
Exit For
End If
Next
End Sub



<DataForm内のコード>

新しく入力したデータを、シートに転送する処理
Sub Newdata()
If ComboBox1.Text = "" Then
MsgBox "名前を入れてください"
ComboBox1.SetFocus
Exit Sub
End If

With Worksheets("Sheet1")
.Rows(1).Insert
.Range("A1") = ComboBox1.Text
.Range("B1") = TextBox1.Text
.Range("C1") = TextBox2.Text
.Range("D1") = TextBox3.Text
.Range("E1") = TextBox4.Text
Columns("A:E").Select
Selection.Sort key1:=Range("B1"), order1:=xlAscending, _
header:=xlGuess, ordercustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, sortmethod:=xlPinYin
.Range("A1").Select
End With
End Sub
新しく入力したデータをシートに転送するプロシージャ
もし、ComboBox1が空白であった場合には、
「名前を入れてください」と表示させ、
ComboBox1にキーボードのフォーカスを設定する。
プロシージャの終了。
IF文の終了。

もし、ComboBox1が空白でなかった場合には、Sheet1に、
シートの先頭に1行追加する。
RangeA1にComboBox1のテキストを入れる。
RangeB1にTextBox1のテキストを入れる。
RangeC1にTextBox2のテキストを入れる。
RangeD1にTextBox3のテキストを入れる。
RangeE1にTextBox4のテキストを入れる。
A〜E列を選択する。
B1を基準にしてソートする。


RangeA1を選択する。
Withステートメントの終了。
プロシージャの終了。

ソートについて
構文は

expression.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod)

Key1,Key2,Key3 省略可能です。並べ替えに使用するキーを1〜3まで指定できる。
Order1,Order2,Oder3 省略可能です。1〜3のそれぞれのキーで、昇順(xlAscending)に並べ替えるか、降順(xlDescending)に並べ替えるかを指定できる。
Type 省略可能です。セル範囲が対象の並べ替え時には不要です。バリアント型 (Variant) の値を使用します。並び替える要素を指定します。使用できる定数は、XlSortType クラスの xlSortValues または xlSortLabels です。この引数は、ピボットテーブルの並べ替えだけに指定できます。
Header 省略可能です。バリアント型 (Variant) の値を使用します。最初の行がタイトル行であるかどうかを指定します。使用できる定数は、XlYesNoGuess クラスの xlGuessxlNoxlYes のいずれかです。先頭行をタイトル行と見なすには、xlYes を指定します。この指定では先頭行を並べ替えの対象にはなりません。タイトル行はないものと見なすには、xlNo を指定します。この指定では範囲全体が並べ替えの対象になります。範囲の先頭行がタイトル行であるかどうかを自動的に判断させるには、xlGuess を指定します。既定の定数は xlNo です。ピボットテーブル レポートの並べ替えに、この引数は指定できません。
OrderCustom ユーザー設定リストの順序にしたがって並び替えるときに、何番目のリストを使用するかを指定。この引数は 1 から始まる整数で、リストの何番目に表示されるかを指定します。引数OrderCustom を省略すると、1 (標準) の設定になります。
MatchCase 省略可能です。バリアント型 (Variant) の値を使用します。大文字と小文字を区別して並べ替えるには、True を指定します。大文字と小文字を区別しないで並べ替えるには、False を指定します。ピボットテーブル レポートの並べ替えに、この引数は指定できません。
Orientation 省略可能です。行単位の並べ替えxlTopToBottom、列単位の並べ替えxlLeftToRightを指定できます。
SortMethod 省略可能です。バリアント型 (Variant) の値を使用します。 並べ替えの種類を指定します。使用できる定数は、XlSortMethod クラスの xlPinYin(フリガナを使う) または xlStroke(フリガナを使わない) です。選択またはインストールされている言語の設定 (たとえば、日本語) によって定数が使用できない場合があります。


修正したデータを、シートに転送する処理
Sub Datashusei()
If ComboBox1.Text <> "" Then
With Worksheets("Sheet1")
On Error GoTo hyouji
.Range("A" & gyou) = ComboBox1.Text
.Range("B" & gyou) = TextBox1.Text
.Range("C" & gyou) = TextBox2.Text
.Range("D" & gyou) = TextBox3.Text
.Range("E" & gyou) = TextBox4.Text
End With
Else
GoTo hyouji
End If
Exit Sub
hyouji:
MsgBox "修正する名前を選んでください"
ComboBox1.SetFocus
End Sub

修正したデータを、シートに転送するプロシージャ
もし、ComboBox1のテキストが空白でなかったら
RangeA1にComboBox1のテキストを入れる。
RangeB1にTextBox1のテキストを入れる。
RangeC1にTextBox2のテキストを入れる。
RangeD1にTextBox3のテキストを入れる。
RangeE1にTextBox4のテキストを入れる。
エラーが発生したり、空白であった場合には、
「修正する名前を選んでください」を表示する。

プロシージャの終了。

入力ボタンがクリックされた時に「入力」か「修正入力」かを判断して、プロシージャを実行させる
Private Sub NyuryokuButton_Click()
Select Case NyuryokuButton.Caption
Case "入力"
Call Newdata
Case "修正入力"
Call Datashusei
End Select
End Sub
入力ボタンをクリックした時に作動するプロシージャ
入力ボタン表示が「入力」の場合、
Newdataを実行する。

入力ボタンの表示が「修正入力」の場合、
Datashuseiを実行する。
Select Caseステートメントの終了。
プロシージャの終了。

ComboBox1が変更された時に内容を表示する
Private Sub ComboBox1_Change()
Dim namae As String
Dim WS As Worksheet
Set WS = Worksheets("Sheet1")
namae = ComboBox1.Text

For Each namaedata In WS.Range("A:A")
If namaedata.Value = "" Then
Exit Sub
ElseIf namaedata.Value = namae Then
gyou = namaedata.Row
With WS
TextBox1.Text = .Range("B" & gyou)
TextBox2.Text = .Range("C" & gyou)
TextBox3.Text = .Range("D" & gyou)
TextBox4.Text = .Range("E" & gyou)
End With
End If
Next
End Sub
ComboBox1が変更された時に内容が表示されるプロシージャ




Aが空白でなかったら、Aと同じ行数のB、C、D、Eデータを
それぞれのTextBoxに表示する。











プロシージャの終了

終了ボタンの処理
Private Sub EndButton_Click()
Unload Me
End Sub
終了ボタンをクリックした時に作動するプロシージャ

gyouの宣言について
gyouという変数を複数のプロシージャ内で使用するので、モジュールレベルの変数として先頭に宣言します。
Dim gyou As Long gyouを長整数として宣言

これで顧客管理マクロの完成です。



名前による検索機能の追加
顧客名が多くなると、ComboBoxから名前を探すのが厄介になってきます。そこで今度は、名前による検索機能を追加しましょう。
コマンドボタンを押すと、
の画面が出てきて名前を入力すると、
という画面が出てくる。佐藤大輔でなければ「いいえ」を押すと、次の佐藤が出てくる。
「はい」を押すと、佐藤一郎の内容が表示されます。

この機能を追加するマクロは、
Private Sub CommandButton1_Click()
Dim aa As Long, b As Integer
Dim s As String
Dim z As Object
Dim Source As String
Dim WS As Worksheet

Worksheets("Sheet1").Activate
aa = ActiveSheet.UsedRange.Rows.Count
Range("A1", "A" & aa).Select

s = InputBox(prompt:="検索したい名前を入力してください", Title:="検索")
Set z = Range("A1", "A" & aa).Find(What:=s, LookIn:=xlValues)
If z Is Nothing Then
MsgBox "該当の文字がありません"
GoTo TheRoutine2

End If

If s = "" Then GoTo TheRoutine

Selection.Find(What:=s, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

b = MsgBox(ActiveCell.Value, vbYesNoCancel, "OKの場合は「はい」を、次を検索する場合は「いいえ」をクリック")

Do While b = 7


Selection.FindNext(After:=ActiveCell).Activate

b = MsgBox(ActiveCell.Value, vbYesNoCancel, "OKの場合は「はい」を、次を検索する場合は「いいえ」をクリック")
Loop

If b = 6 Then

Set WS = Worksheets("Sheet1")
Source = ActiveCell.Text
For Each DataName In WS.Range("A:A")
If DataName.Value = "" Then
Exit Sub
ElseIf DataName.Value = Source Then
gyou = DataName.Row
With WS
TextBox1.Text = .Range("B" & gyou)
TextBox2.Text = .Range("C" & gyou)
TextBox3.Text = .Range("D" & gyou)
TextBox4.Text = .Range("E" & gyou)

ComboBox1.Text = Source

End With
End If
Next

TheRoutine:
MsgBox "×、キャンセル又は入力誤りです"

TheRoutine2:

End If

End Sub

となります。これまでの応用でできますので、解説は省きます。検索機能を追加する場合には、このマクロを利用されますと便利だと思います。