【Acsess VBA】都道府県コード表（新規登録・変更フォームの共通化、VBAからの組み込みSQL実行、Recordsetの選択etc…)

Accessを食わず嫌いできる状況でなくなってきたので、練習で「都道府県コード表」を作成。

データの内容はなんてことない、都道府県コードをテーブル化したもの。

今回は、VBA上で登録・削除・変更機能をフォームで実装することが目標だ。

メインフォームのソース

Option Compare Database

‘登録ボタンクリック
Private Sub 登録btn_Click()
Access.Application.DoCmd.OpenForm "登録・変更フォーム", , , , , , "登録モード"
End Sub

‘変更ボタンクリック
Private Sub 変更btn_Click()

Access.Application.DoCmd.OpenForm "登録・変更フォーム", , , , , , "変更モード"

End Sub

‘削除ボタンクリック
Private Sub 削除btn_Click()

Dim objDB As New MDBAccess ‘データベース操作クラス
Dim strSQL As String ‘SQL組み立て用
Dim lngCurrent As Long ‘削除前に選択していたレコード番号の保存用
‘一覧に表示されている件数をチェック
If Me.テーブル1のサブフォーム.Form.Recordset.RecordCount = 0 Then
   ‘0件のときはエラーメッセージを表示
   MsgBox Me.テーブル1のサブフォーム.Form.Name & "にデータがありません", vbOKOnly + vbInformation, "削除できません"
Else
   ‘SQLの組み立て。レコードの特定は、フィールド「IDキー」で。
   strSQL = ""
   strSQL = strSQL _
            & "DELETE FROM テーブル1" _
            & " WHERE ID = " & Me.テーブル1のサブフォーム.Form("ID").Value

   ‘削除の確認
   If MsgBox("ID=" & Me.テーブル1のサブフォーム.Form("ID").Value & "を削除しますか？" _
               , vbYesNo + vbExclamation, "削除の確認") = vbYes Then

      ‘削除OKのときは削除を実行します

      ‘トランザクション開始
      objDB.BeginTrans

      ‘削除の実行と結果判定
      If objDB.ExecSQL(strSQL) = True Then

         ‘削除が成功したときはコミット
         objDB.Commit

         ‘メニューの一覧で現在選択しているレコード番号の取得
         lngCurrent = Me.テーブル1のサブフォーム.Form.CurrentRecord
         ‘1つ前のレコードを選択するために減算
         lngCurrent = lngCurrent – 1
         ‘一覧の更新
         Me.テーブル1のサブフォーム.Form.Requery
         ‘一覧を選択します(これを行わないとDoCmd.GoToRecordを実行できません)
         Me.テーブル1のサブフォーム.SetFocus

         ‘レコードを移動、ただしlngCurrentが0より大きいとき
         If lngCurrent > 0 Then
            DoCmd.GoToRecord acActiveDataObject, , acGoTo, lngCurrent
         End If

         ‘削除完了メッセージ
         MsgBox "削除しました！", vbOKOnly + vbInformation, "削除完了"

      Else
         ‘更新が失敗したときはロールバック
         objDB.Rollback
         ‘更新失敗メッセージ
         MsgBox "DBエラーが発生しました", vbOKOnly + vbExclamation, "更新失敗"
      End If

      ‘クラスのインスタンスを破棄
      Set objDB = Nothing
   End If
End If

End Sub

登録・変更フォームのソース

Option Compare Database

Private Sub Form_Open(Cancel As Integer)
Debug.Print Me.OpenArgs

‘初期化
Me.ID = ""
Me.都道府県番号 = ""
Me.都道府県 = ""
Me.県庁所在地 = ""
‘IDは変更させないように入力を無効とする。
Me.ID.Enabled = False

If Me.OpenArgs = "登録モード" Then
      Me.ヘッダ名.Caption = Me.OpenArgs
      Call Form_Open_登録(Cancel)

ElseIf Me.OpenArgs = "変更モード" Then
      Me.ヘッダ名.Caption = Me.OpenArgs
      Call Form_Open_変更(Cancel)
Else
      Exit Sub
End If

End Sub

Private Sub Form_Open_登録(Cancel As Integer)

End Sub

Private Sub Form_Open_変更(Cancel As Integer)

‘メニューの一覧を更新する
Dim f As Form
Dim sf As SubForm
Set f = Forms("メインフォーム")
Set sf = f("テーブル1のサブフォーム")
Debug.Print sf.Form("ID").Value
‘フォームを最大化します
‘DoCmd.Maximize

Dim objDB As New MDBAccess ‘データベース操作クラス
Dim strSQL As String       ‘SQL組み立て用

‘SQLの組み立て
strSQL = ""
strSQL = strSQL _
         & "SELECT * " _
         & " FROM テーブル1" _
         & " WHERE ID =" _
         & sf.Form("ID").Value

‘SELECTの実行と結果判定
If objDB.ExecSelect(strSQL) = True Then

   ‘SELECTが成功したときはフォームのコントロールへ取得した内容をセットする
   Me.ID = objDB.GetRS.Fields("ID").Value
   Me.都道府県番号 = objDB.GetRS.Fields("都道府県番号").Value
   Me.都道府県 = objDB.GetRS.Fields("都道府県").Value
   Me.県庁所在地 = objDB.GetRS.Fields("県庁所在地").Value

‘SELECTが失敗したとき
Else
   ‘登録失敗メッセージ
      MsgBox "DBエラーが発生しました", vbOKOnly + vbExclamation, "呼び出し失敗"

   ‘フォームを閉じる
   Call Access.Application.DoCmd.Close(acForm, Me.Name, acSaveNo)

End If

‘クラスのインスタンスを破棄
Set objDB = Nothing

End Sub

Private Sub キャンセルbtn_Click()
      Call Access.Application.DoCmd.Close(acForm, Me.Name, acSaveNo)
End Sub

Private Sub 実行btn_Click()
Debug.Print Me.OpenArgs

If Me.OpenArgs = "登録モード" Then
      Call 登録実行btn_Click

ElseIf Me.OpenArgs = "変更モード" Then
      Call 変更実行btn_Click
Else
      Exit Sub
End If
End Sub

Private Sub 登録実行btn_Click()

If IsNumeric(Me.都道府県番号.Value) = False Then
      MsgBox Me.都道府県番号.Name & "を数字で入力してください", vbOKOnly + vbInformation, "入力エラー"
      Me.都道府県番号.SetFocus
      Exit Sub

ElseIf IsNull(Me.都道府県.Value) = True Then
      MsgBox Me.都道府県.Name & "を入力してください", vbOKOnly + vbInformation, "入力エラー"
      Me.都道府県.SetFocus
      Exit Sub

ElseIf IsNull(Me.県庁所在地.Value) = True Then
      MsgBox Me.県庁所在地.Name & "を入力してください", vbOKOnly + vbInformation, "入力エラー"
      Me.県庁所在地.SetFocus
      Exit Sub

End If

Dim objDB As New MDBAccess ‘データベース操作クラス
Dim strSQL As String       ‘SQL組み立て用

‘SQLの組み立て
strSQL = ""
strSQL = strSQL _
         & "INSERT INTO テーブル1 " _
         & "    (都道府県番号,都道府県,県庁所在地) " _
            & "VALUES (‘" & Me.都道府県番号.Value & "’" _
            & ",’" & Me.都道府県.Value & "’" _
            & ",’" & Me.県庁所在地.Value & "’" _
            & ") "

   ‘トランザクション開始
   objDB.BeginTrans

   ‘追加の実行と結果判定
   If objDB.ExecSQL(strSQL) = True Then
      ‘追加が成功したときはコミット
      objDB.Commit
      ‘登録完了メッセージ
      MsgBox "登録しました！", vbOKOnly + vbInformation, "登録完了"

      ‘フォームを閉じる
      Call Access.Application.DoCmd.Close(acForm, Me.Name)

      ‘メニューの一覧を更新する
      Dim f As Form
      Dim sf As SubForm
      Set f = Forms("メインフォーム")
      Set sf = f("テーブル1のサブフォーム")
      sf.Requery
      ‘一覧を選択します(これを行わないとDoCmd.GoToRecordを実行できません)
      sf.SetFocus
      ‘最終レコード(追加したレコード)へ移動します
      DoCmd.GoToRecord acActiveDataObject, , acLast


   Else
      ‘追加が失敗のときはロールバック
      objDB.Rollback
      ‘登録失敗メッセージ
      MsgBox "DBエラーが発生しました", vbOKOnly + vbExclamation, "登録失敗"
   End If

   ‘クラスのインスタンスを破棄
   Set objDB = Nothing

End Sub

Private Sub 変更実行btn_Click()

If IsNumeric(Me.都道府県番号.Value) = False Then
      MsgBox Me.都道府県番号.Name & "を選択してください", vbOKOnly + vbInformation, "入力エラー"
      Me.都道府県番号.SetFocus
      Exit Sub

ElseIf IsNull(Me.都道府県.Value) = True Then
      MsgBox Me.都道府県.Name & "を選択してください", vbOKOnly + vbInformation, "入力エラー"
      Me.都道府県.SetFocus
      Exit Sub

ElseIf IsNull(Me.県庁所在地.Value) = True Then
      MsgBox Me.県庁所在地.Name & "を選択してください", vbOKOnly + vbInformation, "入力エラー"
      Me.県庁所在地.SetFocus
      Exit Sub

End If

Dim objDB As New MDBAccess ‘データベース操作クラス
Dim strSQL As String       ‘SQL組み立て用

‘SQLの組み立て
strSQL = ""
strSQL = strSQL _
            & "UPDATE テーブル1" _
            & " SET 都道府県番号 = " & Me.都道府県番号.Value _
            & "    ,都道府県 = ‘" & Me.都道府県.Value & "’" _
            & "    ,県庁所在地 = ‘" & Me.県庁所在地.Value & "’" _
            & " WHERE ID = " & Me.ID.Value

   ‘トランザクション開始
   objDB.BeginTrans

   ‘追加の実行と結果判定
   If objDB.ExecSQL(strSQL) = True Then
      ‘追加が成功したときはコミット
      objDB.Commit
      ‘登録完了メッセージ
      MsgBox "登録しました！", vbOKOnly + vbInformation, "登録完了"

      ‘フォームを閉じる
      Call Access.Application.DoCmd.Close(acForm, Me.Name)

      ‘メニューの一覧を更新する
      Dim f As Form
      Dim sf As SubForm
      Set f = Forms("メインフォーム")
      Set sf = f("テーブル1のサブフォーム")

      sf.Requery
      ‘一覧を選択します(これを行わないとDoCmd.GoToRecordを実行できません)
      sf.SetFocus
      ‘最終レコード(追加したレコード)へ移動します
      DoCmd.GoToRecord acActiveDataObject, , acLast

   Else
      ‘追加が失敗しっときはロールバック
      objDB.Rollback
      ‘登録失敗メッセージ
      MsgBox "DBエラーが発生しました", vbOKOnly + vbExclamation, "登録失敗"
   End If

   ‘クラスのインスタンスを破棄
   Set objDB = Nothing

End Sub

他、SQLを使うために、MDBAccessクラスを参考にさせてもらった。

これで、思った機能（都道府県コードの登録、変更、削除）は実装できた。

実装を通して、似たような機能になる登録と変更フォームは、OpenForm のOpenArgs引数でフォームを共通化する手段がわかったし、自分のフォーム、自分のサブフォーム、他フォーム、他サブフォームへのアクセスもだいたい理解できた。

VBAからの組み込みSQL実行についても、MDBaccessのソースで概念はわかった。

エラー判定は、もう少し手をいれてもいいかもしれない。

あとはrecordsetの概念と、Docmdの癖を見極められたらある程度accessが使えるようになるのかな。。

まだこんなレベルで出来はよくないかもしれないけど、とりあえずいろいろ触って慣れないと。。

【Acsess VBA】都道府県コード表（新規登録・変更フォームの共通化、VBAからの組み込みSQL実行、Recordsetの選択etc…)

いいね:

コメント

共有:

いいね:

コメント