今回は初登場ですが、Access VBAについて書いてみたいと思います。
皆さんはAccessのデータをExcelで表示させたいと思ったことはありませんか?
たまたま、仕事の関係でこれまでExcelで管理していた表がExcelの行制限65536行を超えそうだということでAccess化しようということになり、これまでExcel VBAの処理をAccess VBAに変更したのでそのマクロのエッセンスを公開してみようと思いました。
今回ご紹介するのは、Excel側からAccessのデータを、シートに貼り付ける方法とユーザフォームのリストボックスに表示する方法の2通りです。Accessのデータをシートに貼り付けられるのであれば、そもそもAccessにする必要はないじゃないかとお思いになる方がいらっしゃると思いますが、そこはまぁ置いておきましょう。で、以下がそのマクロです。
Public MyArray()
Public Const cGetFld As Integer = 5
Public Const cDbPath As String = "anime.mdb"
Public Const cSqlText As String = "Select * from アニメタイトル"
'新規ブックにデータ貼り付け
Private Sub m_GetAccessData()
Dim i As Integer, j As Integer, k As Integer, l As Integer
' Cells.ClearComments
Application.Calculation = xlManual
Application.ScreenUpdating = False
Workbooks.Add
Call mGetAccessData
k = 1
For i = 1 To UBound(MyArray, 1)
k = k + 1
l = 0
For j = 1 To UBound(MyArray, 2)
l = l + 1
Cells(k, l).Value = MyArray(i, j)
Next
Next
Range(Cells(1, 1), Cells(1, 5)) = Array("タイトル", "放送開始日時", "曜日", "放送終了日時", "視聴局")
Cells.Select
Cells.EntireColumn.AutoFit
Rows("2:2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 85
Columns("C:C").Select
Selection.NumberFormatLocal = "aaa"
Columns("C:C").EntireColumn.AutoFit
Range("A1").Select
Erase MyArray
Application.Calculation = xlAutomatic
Application.ScreenUpdating = False
End Sub
Public Sub mGetAccessData()
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set oDb = wrkJet.OpenDatabase(ThisWorkbook.Path & "\" & cDbPath, False)
Set oRst = oDb.OpenRecordset(cSqlText, dbOpenDynaset, dbReadOnly)
oRst.MoveLast
ReDim MyArray(1 To oRst.RecordCount, 1 To cGetFld)
Dim i As Integer, j As Integer, k As Integer
oRst.MoveFirst
With oRst
Do While Not .EOF
Doevents
i = i + 1
k = 0
For j = 1 To cGetFld
k = k + 1
MyArray(i, k) = .Fields(j)
Next
.MoveNext
Loop
End With
oDb.Close
Set wrkJet = Nothing
Set oDb = Nothing
Set oRst = Nothing
End Sub
~ユーザフォーム~
'リストボックスにデータ貼り付け
Private Sub UserForm_Initialize()
Call mGetAccessData
Me.ListBox1.ColumnCount = cGetFld
Me.ListBox1.List() = MyArray
Me.Label1.Caption = UBound(MyArray, 1) & "件"
Erase MyArray
End Sub
それでは、解説していきます。まず、Accessデータベースの情報をConstで設定しています。今回は以下のようなデータベースを前提に処理します。
<anime.mdb>
テーブル名:アニメタイトル
id オートナンバー型 主キー
タイトル テキスト型
放送開始日時 日付/時刻型
曜日 日付/時刻型
放送終了日時 日付/時刻型
視聴局 テキスト型
まずAccessデータをシートに貼り付ける処理です。
m_GetAccessDataモジュールがメイン処理となりますが、新規ブックを作成し、mGetAccessDataでAccessデータを配列に格納し、その配列データをシートに貼り付け、整形して終了となります。
で、肝心のAccessデータの取得部分であるmGetAccessDataモジュールですが、VBEの参照設定には以下を追加することが必要ですのでご承知置きください。
・Microsoft ActiveX data Objects 2.8 Library
・Microsoft Access 11.0 Object Library
・Microsoft DAO3.6 Object Library
で、Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)でワークスペースの作成し、Set oDb = wrkJet.OpenDatabase(ThisWorkbook.Path & "\" & cDbPath, False)で指定のデータベースをオープンし、Set oRst = oDb.OpenRecordset(cSqlText, dbOpenDynaset, dbReadOnly)で指定のSQLを実行し、レコードセットオブジェクトに格納するといのが一連の流れです。この辺はDAOやADOなどいろいろやり方あって私も良く理解していなのですが、ヘルプの記述そのままですので詳細はヘルプをご確認ください。ネット上にも解説したサイトがいろいろあると思います。
前述したとおり、cSqlTextで定義しているSQL文は全件取得ですので場合によってはWhere句で条件を絞る必要があるでしょう。ヘルプによるとパフォーマンスに影響するらしいのですが、oRst.MoveLastで一旦最終行までカレント行を移動し、予めoRst.RecordCountで件数を取得しています。で、oRst.MoveFirstで先頭行にカレント行を移動してEOFまでレコードのフィールド情報を配列に格納して終了となります。
次に、ユーザフォームのリストボックに表示する方法です。まずユーザフォームを作成してリストボックを配置します。で、上記のPrivate Sub UserForm_Initialize()を貼り付けてUserForm1.Showを実行すれば表示されます。
レコード件数が多くなるとどうなるか解りませんが、どちらの方法も思ったよりも結構高速です。
anime.mdbと上記マクロをアップロードしておきますので実際に動かして試してみてくださいね。
「GetAccessData.EXE」をダウンロード
最近のコメント