データ入力ツール②(ExcelでRDBその21)

ExcelでRDB（リレーショナルデータベース）を操作してみようという連載のその21です。前回の記事はこちらです。

hirocom777.hatenadiary.org

データ入力ツール

前回はデータ入力ツールの概要を検討してみました。ここが決まれば形にするのは楽ですね。

今回は、この概要にしたがって作っていけばいいと思います。

既存のツールを流用する

前回作成した概要をおさらいすると、以下になります。

Accessファイルを指定して接続する
データを入力するテーブルを選択する
データ入力のがメニューが現れる
データを入力する
決定ボタンを押すと入力した内容が記録される

このうち上の2つは前回までで開発していたAccessファイル確認ツールを流用できますね。これを使ってひな形を作っていきましょう。

ひな形のデザイン

入力決定ボタンが新たに必要になってきます。また、入力中に間違ってファイル指定ボタンやクリアボタンを押してしまうと、入力した内容が無効になってしまいます。入力決定ボタンと間違って押してしまわないように、位置を離しておきましょう。3つのボタンとも、押した後に確認のメッセージボックスを表示する事にします。

テーブルを選択した際に、該当テーブルのレコード数が取得されると便利です。（ここは、追ってクラスモジュールで取得できるようにします。）

これらの条件をふまえて、入力画面は以下の様になりました。ファイルとテーブルを指定すると、フィールド名と続くデータ型、キーの情報が表示されて、その右側に対応するデータを入力することとします。

ここまでのソースリスト

少し長いのですが、ここまでのソースリスト（クラスモジュールを除く）を掲載します。上の図のシートモジュールに記述しています。ファイルを開いて選択したテーブルに応じて情報を表示するまでを記述しました。

Option Explicit

'Accessファイルの指定を実行します
Public Sub cmdFile_Click()
Dim db As New clsAccessDbase
Dim fileName As String
Dim fileFilter As String
  If MsgBox("ファイルを指定します", vbYesNo) = vbNo Then Exit Sub
  fileFilter = "Accessファイル(*.accdb),*.accdb"
  'ダイアログを表示してファイルを指定
  fileName = Application.GetOpenFilename(fileFilter)
  'テーブルリストを表示します
  Me.ClearData
  If fileName <> "False" Then
    Me.Range("FileName").Value = fileName
    db.dbFileName = fileName
    With Me.Range("TableName").Validation
      .Delete
      TopSheet.Unprotect
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
      xlBetween, Formula1:=Join(db.dbTableList, ",")
      TopSheet.Protect Userinterfaceonly:=True
    End With
    Me.Range("TableName").Value = db.dbTableList(0)
  End If
End Sub

'表示クリアを実行します
Public Sub cmdClear_Click()
  If MsgBox("表示をクリアします", vbYesNo) = vbNo Then Exit Sub
  ClearData
End Sub

'選択テーブルが変更された際にカラムリストの表示を変更します
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Me.Range("TableName").Address And Target.Text <> "" Then
    DispColumnList Me.Range("FileName").Text, Me.Range("TableName").Text
  End If
End Sub

'カラムリストを表示します
Private Sub DispColumnList(fileName As String, tableName As String)
Dim db As clsAccessDbase
Dim i As Long
On Error GoTo ErrorHandler
  '表示をクリアします
  Me.Range("DATA_AREA").ClearContents
  Me.Range("A10").Activate
  Me.Range("TableName").Select
  'カラム情報を表示します
  Set db = New clsAccessDbase
  db.dbFileName = Me.Range("FileName").Text
  db.dbTableName = Me.Range("TableName").Text
  With Me.Range("columnList").Offset(1, 0)
    For i = 0 To UBound(db.dbFieldList)
      .Offset(i, -1) = i + 1
      .Offset(i, 0) = db.dbFieldList(i)
      .Offset(i, 1) = GetDataInfo(CLng(db.dbFieldType(i)))
      .Offset(i, 2) = GetKeyInfo(CLng(db.dbKeyType(i)))
    Next i
  End With
  'レコード数表示します
  Me.Range("RecordCount").Value = db.dbRecordCount
ErrorHandler:
  If Err.Number <> 0 Then MsgBox "テーブルエラーです"
End Sub

'番号からキーの種類を返します
Private Function GetKeyInfo(keyNumber As Long) As String
  Select Case keyNumber
  Case 0: GetKeyInfo = ""
  Case adKeyPrimary: GetKeyInfo = "主キー"
  Case adKeyForeign: GetKeyInfo = "外部キー"
  Case adKeyUnique: GetKeyInfo = "キー"
  Case Else: GetKeyInfo = "???"
  End Select
End Function

'番号からデータ型の種類を返します
Private Function GetDataInfo(DataNumber As Long) As String
  Select Case DataNumber
  Case adGUID: GetDataInfo = "オートナンバー"
  Case adVarWChar: GetDataInfo = "テキスト"
  Case adLongVarWChar: GetDataInfo = "メモ"
  Case adSmallInt: GetDataInfo = "整数"
  Case adInteger: GetDataInfo = "長整数"
  Case adSingle: GetDataInfo = "単精度浮動小数点"
  Case adDouble: GetDataInfo = "倍精度浮動小数点"
  Case adDate: GetDataInfo = "日付"
  Case adDBTimeStamp: GetDataInfo = "日付/時刻"
  Case adCurrency: GetDataInfo = "通貨"
  Case Else:: GetDataInfo = "???"
  End Select
End Function

'表示をクリアします
Public Sub ClearData()
  Me.Range("FileName").ClearContents
  Me.Range("TableName").Validation.Delete
  Me.Range("TableName").Value = ""
  Me.Range("RecordCount").ClearContents
  'テーブル表示をクリアします
  Me.Range("DATA_AREA").Clear
  Me.Range("A10").Activate
End Sub