【その３】では、アンケートフォームにプログラムを組み込んでいきます。
プログラミングといってもアンケートデータ入力フォーム上に入力された内容をExcelに取り込むだけです。素人が作ったものなので間違いがあればご指摘願います。
※入力データの格納をSheet2に固定にしているので、実行時にはBookにSheet2がなければいけません。
・
Excel VBAでアンケートデータ入力フォーム
・
Excel VBAでアンケートデータ入力フォーム【その２】
からの続きです。
参考にしたのは下記の書籍です。
仕事に役立つExcelVBA業務活用編 (Excel徹底活用シリーズ)
| 著者： | 西沢 夢路 |
| 出版社： | ソフトバンククリエイティブ |
| 発売日： | 2008/8/27 |
| 価格： | 2,604円（税込み） |
CHAPTER 06 「ユーザーフォーム」のテクニックに今回作成したいことの内容が掲載されていました。サンプルを見ても何をやっているかわからない部分については、コードから逆引きをして調べました。
コードの表示
ユーザーフォームを選択して、右クリックして「コードの表示」をクリックします。
初期処理
左側の窓に「UserForm」を、右側は「Initialize」を選択します。
すると、下記のようなコードが表示されます。
Private Sub UserForm_Initialize()
End Sub
「Initialize」は、ユーザーフォームを開いたときに実行される初期処理です。
初期処理で３種類の処理を定義します。
コンボボックスの値を設定
・コンボボックスのリストに値を設定するにはAddItemメソッドを使います。
・フォームを開いたときに何も選択されていないようにQ3.ListIndex = -1とします。
後はおまじないです。詳細は書籍やヘルプを参照してください。
ID No.を付与するための番号を取得する
・A列の空白セルを探して、そこからひとつ上の値を返してくれます。
先頭行には項目名があるので、最初はA列の空白セルは2、そのひとつ前なので1となります。
フォームを開いたときにフォーカスをQ1にする
Private Sub UserForm_Initialize()
'****************************************************
' コンボボックスの初期値設定
'****************************************************
Q3.Style = fmStyleDropDownCombo
Q3.RowSource = ""
Q3.Clear
Q3.AddItem "選択肢1"
Q3.AddItem "選択肢2"
Q3.AddItem "選択肢3"
Q3.ListIndex = -1 'コンボボックスを未選択にする
'****************************************************
' ID Noに最終行列の値を挿入（データ未入力時は1）
'****************************************************
ID_No.Value = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
'****************************************************
' Q1_1（MAサンプル 選択肢1）にフォーカス
'****************************************************
Q1_1.SetFocus
End Sub
登録処理
登録ボタンがクリックされたときに実行されます。
左側の窓に「登録」を、右側は「Click」を選択します。すると、下記のようなコードが表示されます。（フォームの登録ボタンをダブルクリックしてもコードが表示されます。
Private Sub 登録_Click()
End Sub
「登録処理」では、自動付与項目とフォームの入力値（アンケート回答値）をSheet2の最終行に追加していきます。そして次のデータエントリーに備えるために初期処理を行います。
ポイントとなるのは、下記の2つです。
With Worksheets("Sheet2")
End With
With から End With の間は、Worksheets（"Sheet2")が適用されるので、セルに値を代入するのに都度ワークシートの定義をせずに .Range だ行うことができます。
.Range("A" & lRow + 1).Value = ID_No.Value
初期処理で設定したID_Noの値を列Aのn行目（lRowの値+1）に格納するという意味になります。
初めてデータ入力をするときであれば、lRowとID_Noには1が代入されているので、A列2行目に1が格納されることになります。
後は、プログラムを参照してください。わからないところがあれば書籍やヘルプで調べてください。
Private Sub 登録_Click()
'*************************************************************
' 登録ボタンが押されたらSheet2のA列の最終行にデータを入力する
'*************************************************************
Dim lRow As Long '変数として使うlROWの定義
With Worksheets("Sheet2") 'End WithまですべてSheet2に対しての処理
lRow = .Range("A" & Rows.Count).End(xlUp).Row 'データの最終行をlRowに代入
.Range("A" & lRow + 1).Value = ID_No.Value 'ID No.を代入
.Range("B" & lRow + 1).Value = Now '現在時刻を取得
.Range("C" & lRow + 1).Value = Environ("COMPUTERNAME") 'コンピュータ名を取得
.Range("D" & lRow + 1).Value = Environ("USERNAME") 'ユーザー名を取得
'************************
' Q1の値を代入 E～G列
'************************
If Q1_1 Then .Range("E" & lRow + 1).Value = 1 Else .Range("E" & lRow + 1).Value = 0
If Q1_2 Then .Range("F" & lRow + 1).Value = 1 Else .Range("F" & lRow + 1).Value = 0
If Q1_3 Then .Range("G" & lRow + 1).Value = 1 Else .Range("G" & lRow + 1).Value = 0
'************************
' Q2の値を代入 H列
'************************
If Q2_1 Then .Range("H" & lRow + 1).Value = 1
If Q2_2 Then .Range("H" & lRow + 1).Value = 2
If Q2_3 Then .Range("H" & lRow + 1).Value = 3
'************************
' Q3の値を代入 I列
'************************
.Range("I" & lRow).Value = Q3.Value
'************************
' Q4の値を代入 J列
'************************
.Range("J" & lRow).Value = Q4.Value
End With
'****************************************************
' 登録ボタン実行後のイニシャライズ処理
'****************************************************
ID_No.Value = Sheet2.Range("A" & Rows.Count).End(xlUp).Row 'ID No.の設定
Q1_1.Value = False 'チェックを外す
Q1_2.Value = False 'チェックを外す
Q1_3.Value = False 'チェックを外す
Q2_1.Value = False 'チェックを外す
Q2_2.Value = False 'チェックを外す
Q2_3.Value = False 'チェックを外す
Q3.ListIndex = -1 'コンボボックスを未選択にする
Q4.Value = "" '値をクリアする
Q1_1.SetFocus 'フォーカスをQ1_1に戻す
End Sub
終了処理
終了ボタンはクリックされたらフォームを閉じます。
Private Sub 終了_Click()
Unload Me ' 終了ボタンが押されたら入力フォームを閉じる
End Sub
以上でコードの入力は終了です。
タブ遷移
マウスを使えば問題にはなりませんが、データ入力の速度をあげるためにキーボードだけで入力できるようにタブの遷移を設定します。（Tabキーで遷移します）
ユーザーフォーム上で右クリックをして「タブ オーダー」を選択して起動します。項目を選択して「上に移動」「下に移動」で順番に移動するように変更してください。
これでプログラムもできあがりです。
次回は、実行方法について記載します。
今日の一曲
Kronos Quarter（クロノス・カルテット）を一躍有名にしたこの一曲です。カルテットという通り弦楽四重奏です。『
The Kronos Quartet Plays Sallinen, Glass, Sculthorpe, Hendrix, Nancarrow』というアルバムですが、邦題は『
紫のけむり~現代の弦楽四重奏曲/クロノス・クァルテット』。Jimi Hendrix（ジミー・ヘンドリックス）の Purple Haze（パープルヘイズ）です。バイオリンとは思えない音の出し方でとても格好いいです。Kronos Quartetは色々なミュージシャンと共演をしていますので、色々と聴いてみてください。
Kronos Quartet
Plays Sallinen, Glass, Sculthorpe, Hendrix, Nancarrow
Purple Haze
『purple haze』はもう少しテンポの遅いバージョンが『
紫のけむり～クロノス・スーパー』に収録されています。こちらもイケてます。しかし、邦題ではどうしても「紫のけむり」と付けたいみたいですね。
Kronos Quartet
Kronos Quartet: Released 1985-1995
Purple Haze
デジタル大辞泉2009iは、広辞苑のiPhone Appl版が\85,00と高額な値段の後、直ぐの発売だったので\2,000という価格で飛びついてしまいましたが、現状では、更に50％で\1,000円で購入できます。評価では「大辞林」に負けていましたが、この価格の国語辞典としては十分だと思います。
で購入する
Laurie Anderson（ローリー・アンドーソン）のBig Scienceに収録されている「o superman」。シンプルな曲ですが、病みつきになります。「O Superman. O judge. O Mom and Dad. Mom and Dad.」というメロディーが頭の中でグルグルとまわります。彼女はパフォーマーとして有名で「ドラム・スーツ」を着用したドラムダンスで一躍有名になりました（？）+%E9%A4%8C%E6%9C%A8%E3%82%A4%E3%82%AB%E5%90%8D%E4%BA%BA+DS+%E3%82%B9%E3%82%B1%E3%83%AB%E3%83%88%E3%83%B3%E3%83%BC%E3%82%AA%E3%83%AC%E3%83%B3%E3%82%B8%26%E3%82%AA%E3%83%AC%E3%83%B3%E3%82%B8+1.8%E5%8F%B7.jpg)
に変えました。
