この記事は、AccessのデータをExcelファイルに出力するVBAプログラミングの後編となります。
前編で取り扱ったのは、Accessテーブルのデータを新しいExcelブックに出力する方法についての解説でした。
後編では、特定のExcelテンプレートを使用し、Accessテーブルのデータを反映する方法に焦点を当てています。
本記事では、購買管理データベースを例に、単票フォームに表示されているデータを伝票テンプレートに貼り付けるためのプログラミングを詳しく説明しています。
Accessにもレポート機能が標準装備されていますが、レイアウトなどの自由度が低いのが欠点です。
Excelへの出力機能をマスターすると、Accessレポートの制限から解放され、自由度が一気に高まります。
本記事の内容までが理解できれば、Accees VBAを使ってExcelを思い通りに操作できるスキルにつながりますので、がんばって学習しましょう。
サンプルデータベースは前編と同じですが、参考までにリンクを入れておきます。
完成品の動作
まずは完成後の動作をかんたんに触れておきます。
サンプルデータベースが入ったフォルダを確認してみましょう。
このフォルダには、サンプルデータベースとともに空の伝票フォームを持つExcelブックが入っています。
下はExcelファイルの中身です。
Accessテーブルのデータはこのレイアウトに反映されます。
次にサンプルデータベースを開き、「F02発注伝票T」をクリックします。
発注履歴確認画面が開きました。
サブフォーム内の特定のレコードを選び、「項目編集」ボタンをクリックします。
伝票の単票フォームが起動します。
下の「伝票発行」ボタンをクリックします。
データが反映されたExcelブックが起動します。
サンプルデータベースのフォルダを確認すると、新しいファイル名でExcelブックが作成されているのが分かります。
このような流れでAccessデータベース内の伝票データがExcelに反映されています。
プログラムコードの解説
では、ここからはコードの動きについての解説にすすみます。
以下がExcelブックにデータ出力するコードです。
Private Sub 伝票発行_Click()
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQL As String
Dim stSQL As String
Dim stList As String
Dim XlsFile As String
Dim Wst As String
Dim objFileSys As Object
Dim strDeleteFrom As String
Dim j As Integer
Dim MAINTm As Long '発注金額
Dim xlApp As Object 'Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.WorkSheet
Dim r As Object
Dim 件数, i As Integer
Dim myArray As Variant
XlsFile = "\" & Me.発注先名.Value & "_" & Format(Me.発注日.Value, "yymmdd") & "_" & Me.発注金額.Value & "円.xlsx"
Wst = "伝票"
FileCopy CurrentProject.Path & "\購買管理原本.xlsx", CurrentProject.Path & "\" & Me.発注先名.Value & "_" & Format(Me.発注日.Value, "yymmdd") & "_" & Me.発注金額.Value & "円.xlsx"
On Error GoTo e
Me.Requery
Set xlApp = CreateObject("Excel.Application") '生成
Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & XlsFile) 'ブック追加
Set xlSheet = xlBook.Worksheets(1)
Set CN = CurrentProject.Connection
Set RS = New ADODB.Recordset
'伝票テーブルデータの貼付
SQL = "SELECT * FROM T02発注伝票 WHERE 発注登録No=" & Me.発注登録No.Value & ";"
RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
件数 = RS.RecordCount
With RS
'発注先がネットショップであるか確認
If DLookup("[ネットショップ]", "T01発注先マスタ", "[発注先名]='" & !発注先名.Value & "'") = True Then
xlSheet.Range("B4").Value = "インターネットショップ" 'ネットショップ
ElseIf DLookup("[小口現金]", "T01発注先マスタ", "[発注先名]='" & !発注先名.Value & "'") = True Then
xlSheet.Range("B4").Value = "小口現金購入" '小口現金購入
Else
xlSheet.Range("B4").Value = !発注先名.Value '発注先
End If
If !担当者名.Value = Null Then
xlSheet.Range("B6").Value = ""
Else
xlSheet.Range("B6").Value = !担当者名.Value & "様"
End If
xlSheet.Range("F11").Value = !発注日.Value '発注日
xlSheet.Range("F2").Value = !管理No.Value '管理No
xlSheet.Range("G8").Value = !発注者.Value '発注者
xlSheet.Range("B29").Value = !備考.Value '備考
End With
RS.Close
'伝票明細テーブルデータの貼付
SQL = "SELECT * FROM T02発注伝票明細 WHERE 発注登録No=" & Me.発注登録No.Value & ";"
RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
件数 = RS.RecordCount
With RS
.MoveFirst
For i = 0 To 件数 - 1
xlSheet.Range("B13").Offset(i, 0) = !品名.Value
xlSheet.Range("C13").Offset(i, 0) = !規格.Value
xlSheet.Range("D13").Offset(i, 0) = !数量.Value
xlSheet.Range("E13").Offset(i, 0) = !単価.Value
xlSheet.Range("G13").Offset(i, 0) = !希望納期.Value
.MoveNext
Next i
End With
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
xlApp.Visible = True '表示
xlBook.Activate
' オブジェクトの参照を解放
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
e:
MsgBox ("システムエラーが発生しました。" & vbCrLf & Err.Number & ":" & Err.Description)
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
End Sub
かなり長いコードですよね。
各動作を分解すると、以下のようになっています。
- 伝票用Excelブックを複製して開く
- Accessテーブルから対象伝票のレコードを取得
- Excelブックに伝票データを反映
- 明細データをExcelに反映
- Excelブックの表示を有効化
では、順番に解説していきます。
下のコードでは、ひな形のExcelブックから伝票用のブックを複製して開くところまでを実現しています。
XlsFile = "\" & Me.発注先名.Value & "_" & Format(Me.発注日.Value, "yymmdd") & "_" & Me.発注金額.Value & "円.xlsx"
Wst = "伝票"
FileCopy CurrentProject.Path & "\購買管理原本.xlsx", CurrentProject.Path & "\" & Me.発注先名.Value & "_" & Format(Me.発注日.Value, "yymmdd") & "_" & Me.発注金額.Value & "円.xlsx"
On Error GoTo e
Me.Requery
Set xlApp = CreateObject("Excel.Application") '生成
Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & XlsFile) 'ブック追加
Set xlSheet = xlBook.Worksheets(1)
「CurrentProject.Path」というワードが使われていますが、今使っているAccessデータベースのフォルダを指定しています。
伝票フォーマットが入っているExcelブック「購買管理原本.xlsx」を複製し、同じフォルダに変数「XlsFile」に相当するブックを作成しています。
複製が済んだら、新しい方のExcelブックを開きます。
バックグラウンドで開いているので、プログラム実行時は非表示の状態です。
次に、単票フォームに表示されているデータを操作するため、ADOを設定したのが下のコードです。
Set CN = CurrentProject.Connection
Set RS = New ADODB.Recordset
'伝票テーブルデータの貼付
SQL = "SELECT * FROM T02発注伝票 WHERE 発注登録No=" & Me.発注登録No.Value & ";"
RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
件数 = RS.RecordCount
発注伝票テーブルの発注登録Noからデータを指定しています。
以下は伝票テーブルのデータをExcelブックに反映するコードです。
With RS
'発注先がネットショップであるか確認
If DLookup("[ネットショップ]", "T01発注先マスタ", "[発注先名]='" & !発注先名.Value & "'") = True Then
xlSheet.Range("B4").Value = "インターネットショップ" 'ネットショップ
ElseIf DLookup("[小口現金]", "T01発注先マスタ", "[発注先名]='" & !発注先名.Value & "'") = True Then
xlSheet.Range("B4").Value = "小口現金購入" '小口現金購入
Else
xlSheet.Range("B4").Value = !発注先名.Value '発注先
End If
If !担当者名.Value = Null Then
xlSheet.Range("B6").Value = ""
Else
xlSheet.Range("B6").Value = !担当者名.Value & "様"
End If
xlSheet.Range("F11").Value = !発注日.Value '発注日
xlSheet.Range("F2").Value = !管理No.Value '管理No
xlSheet.Range("G8").Value = !発注者.Value '発注者
xlSheet.Range("B29").Value = !備考.Value '備考
End With
RS.Close
一行ずつ読み解いていくと、指定されたセルに各フィールドのデータを当てはめているのが分かると思います。
また、DlookupなどのようなAccess関数もVBAプログラミングで使用可能です。
この部分の終わりの箇所では、伝票テーブルのデータは用済みなので、いったんADOから解放しています。
以下は明細データ(サブフォーム)のデータを反映するコードです。
'伝票明細テーブルデータの貼付
SQL = "SELECT * FROM T02発注伝票明細 WHERE 発注登録No=" & Me.発注登録No.Value & ";"
RS.Open SQL, CN, adOpenKeyset, adLockOptimistic
件数 = RS.RecordCount
With RS
.MoveFirst
For i = 0 To 件数 - 1
xlSheet.Range("B13").Offset(i, 0) = !品名.Value
xlSheet.Range("C13").Offset(i, 0) = !規格.Value
xlSheet.Range("D13").Offset(i, 0) = !数量.Value
xlSheet.Range("E13").Offset(i, 0) = !単価.Value
xlSheet.Range("G13").Offset(i, 0) = !希望納期.Value
.MoveNext
Next i
End With
RS.Close: Set RS = Nothing
CN.Close: Set CN = Nothing
伝票明細テーブルのデータもADOで設定しています。
対象レコードが複数存在するので、繰り返し文を使っています。
最後にバックグラウンドで作動させていたExcelブックを画面に表示させ、Excelオブジェクトを全て開放します。
xlApp.Visible = True '表示
xlBook.Activate
' オブジェクトの参照を解放
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
まとめ
Accessのデータを伝票用Excelファイルに反映させるプログラミングを解説しました。
本記事の内容からさらに進化すれば、AccessからExcelのほとんどの機能を実行できます。
関数はもちろん、テーブル化、ピボットテーブル、スライサー、グラフなど、挙げるときりがありません。
とにかく、データ管理や分析などを行うときにとても便利な機能ですので、がんばってマスターしていきましょう。
本記事で、いったんAccess VBAのシリーズはいったん終わります。
過去記事までの情報も活用すれば、きっと便利なAccessシステムを構築できるでしょう。
Access以外にも、Excelについてもいろんな目線で記事を投稿していますので、そちらもどうぞよろしくお願いします。