Excel VBA でアンケートデータ入力フォーム【その３】

【その３】では、アンケートフォームにプログラムを組み込んでいきます。

プログラミングといってもアンケートデータ入力フォーム上に入力された内容を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