ユーザフォーム入門 - 住所入力フォームを作成する(4) 〜 ワークシートへの転記他
ここでは、テクニック集”ユーザーフォーム入門−住所入力フォームを作成する(3)”
までの作業を前提として、ユーザフォームに配置したコントロールからワークシートに
転記する手法を考えます。

フォーム上の各テキストボックスへの入力が終わり、”登録”ボタンクリック時に
専用ブック”住所録.xls”へ転記し、連続入力によって表形式でデータを保存する
こととします。

■フォーム起動時に専用ブックを開く■
ユーザフォームを含むブックと同じフォルダ内に”住所録.xls”があればそれを開き、
なければ作成します。

・コーディングの準備
⇒ 1.VBEのプロジェクトウィンドウからユーザフォームのアイコンを選択。
  2.右クリックでショートカットメニューから”コードの表示”を選び、
    コードウィンドウを表示させる。
  3.コードウィンドウ上部左の”オブジェクトボックス”
    (初期状態:”General”の表示)から”UserForm”を選択。上部右側の
    ”プロシージャボックス(初期状態:”Click”)から”Initialize”を選択。
    コードウィンドウに以下のプロシージャの雛型が挿入されます。

    Private Sub UserForm_Initialize()
       
    End Sub

(サンプル:まるごとコードウィンドウに上書きペーストしてください)
'===========================================================
'ブック名を格納する定数(定数は変数と違い、中身の書き換え不可)
Private Const BOOK_NAME As String = "住所録.XLS"

    ’フォーム初期化時のイベント
    Private Sub UserForm_Initialize()

    Dim strPath As String
    Dim Returnvalue As String
    Dim wbJusho As Workbook

    '住所録.xlsが開いていればワークブック型変数に格納。
    '開いていない場合に備えてエラー処理
    
    On Error Resume Next
    '開いている場合には変数に格納後、プロシージャを抜ける
    Set wbJusho = Workbooks(BOOK_NAME)
    If Err = 0 Then Exit Sub
    On Error GoTo 0

    'ユーザフォームを含むブックのパスと定数BOOK_NAMEを連結してブックのフルパスとする
    strPath = ThisWorkbook.Path & "\" & BOOK_NAME

    'Dir関数でファイル存在確認(戻り値:存在→”ファイル名”、存在しなければ空白)
    Returnvalue = Dir(strPath)

    'Dir関数の戻り値により処理分岐
    '空白の場合はブック追加。シート1に項目名を設定。
    If Returnvalue = "" Then
        Set wbJusho = Workbooks.Add
        wbJusho.Sheets("sheet1").Range("A1:I1").Value = _
            Array("会社名", "よみ", "郵便番号", "住所1", "住所2", "TEL", "FAX", _
                  "Email", "担当")
        'シート1のすべてのセル表示形式を文字列とする
        wbJusho.Sheets("sheet1").Cells.NumberFormatLocal = "@"
        wbJusho.SaveAs strPath
    'その他(ファイルが存在する場合)
    Else
        'ブックを開く
        Set wbJusho = Workbooks.Open(strPath)
    End If

End Sub
'===========================================================

■ワークシートへの転記■

コントロールからワークシートへには幾通りかの方法がありますが、ここではテキストボ
ックスに入力された値をそのまま専用ブックの”Sheet1”に表形式で転記します。

(コーディングの準備)
コードウィンドウのオブジェクトボックスからcmdTouroku(”登録”ボタンのオブジェクト名)
を選択。コードウィンドウにコマンドボタンの既定のイベントであるクリックイベントのプロシ
ージャ雛形が挿入される。

※コマンドボタンをダブルクリックすることでもクリックイベントプロシージャの雛型をコード
ウィンドウに挿入できます。

(転記の基本)
	
    対象セルのValueプロパティーにテキストボックスのValue(またはText)プロパティー
    の値を代入します。

    例 : Range("A1").Value = TextBox1.Value

 次のサンプルでは転記作業のほか、転記後に次のデータを入力する場合のためにテキストボッ
 クスのデータをクリアしています。

(サンプル)
'===========================================================
Private Sub cmdTouroku_Click()

    Dim lngRowNum As Long
    Dim Ctrl As Control

    With Workbooks(BOOK_NAME).Sheets("sheet1")

        'セル”A65536"からEndプロパティーを用いてシート上の最終行を取得し、
        '+1で次の行番号を取得
        '※セルA65536からコントロールキー+↑キーを押して選択されるセルの直下の行番号
        lngRowNum = .Cells(65536, 1).End(xlUp).Row + 1

        'ワークシートの行列を指定して個別にテキストボックスの値をセルへ格納
        '”Me”はユーザフォーム自体をあらわします。
            .Cells(lngRowNum, 1).Value = Me.txtKaisha.Value
            .Cells(lngRowNum, 2).Value = Me.txtYomi.Value
            .Cells(lngRowNum, 3).Value = Me.txtYubin.Value
            .Cells(lngRowNum, 4).Value = Me.txtJusho1.Value
            .Cells(lngRowNum, 5).Value = Me.txtJusho2.Value
            .Cells(lngRowNum, 6).Value = Me.txtTEL.Value
            .Cells(lngRowNum, 7).Value = Me.txtFAX.Value
            .Cells(lngRowNum, 8).Value = Me.txtEmail.Value
            .Cells(intRowNum, 9).Value = Me.txtTantou.Value

    End With

    'フォーム上のコントロールすべてをFor Eachステートメントで
    'ループ。コントロール名が”txt”で始まるもののみ値をクリア
    For Each Ctrl In Me.Controls
        If Ctrl.Name Like "txt*" Then
            Ctrl.Value = ""
        End If
    Next

End Sub
'===========================================================

※Meキーワードはフォームモジュール内で使用すると、フォーム自体をあらわしますが、
 使用する必要性はありません。ただ、コードを記述する際には”Me.・・・”と記述する
 ことでメンバー表示機能が有効となり、コントロールのオブジェクト名やプロパティー
 名などを正確かつ迅速に行うことが出来るようになります。


Excel2000



戻る


Excel Word Access VBA! モーグ