2009年9月10日木曜日

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

このエントリーをはてなブックマークに追加
【その3】では、アンケートフォームにプログラムを組み込んでいきます。

プログラミングといってもアンケートデータ入力フォーム上に入力された内容をExcelに取り込むだけです。素人が作ったものなので間違いがあればご指摘願います。

※入力データの格納をSheet2に固定にしているので、実行時にはBookにSheet2がなければいけません。

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

からの続きです。

参考にしたのは下記の書籍です。

仕事に役立つExcelVBA業務活用編 (Excel徹底活用シリーズ)
著者: 西沢 夢路
出版社:  ソフトバンククリエイティブ
発売日: 2008/8/27
価格: 2,604円(税込み)

CHAPTER 06 「ユーザーフォーム」のテクニックに今回作成したいことの内容が掲載されていました。サンプルを見ても何をやっているかわからない部分については、コードから逆引きをして調べました。





コードの表示

ユーザーフォームを選択して、右クリックして「コードの表示」をクリックします。



初期処理

左側の窓に「UserForm」を、右側は「Initialize」を選択します。
すると、下記のようなコードが表示されます。
Private Sub UserForm_Initialize()

End Sub

「Initialize」は、ユーザーフォームを開いたときに実行される初期処理です。
初期処理で3種類の処理を定義します。

コンボボックスの値を設定

・コンボボックスのリストに値を設定するには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

関連記事


コメントを投稿