2017年12月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            

« ▼ダイエット大作戦(やっと82Kg) | トップページ | ◆E2000Tools(第14回目「ファイル名一括変換」機能) »

2007年6月24日 (日)

◇Access VBA(AccessデータをExcelで表示させるマクロ)

今回は初登場ですが、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」をダウンロード

« ▼ダイエット大作戦(やっと82Kg) | トップページ | ◆E2000Tools(第14回目「ファイル名一括変換」機能) »

パソコン・インターネット」カテゴリの記事

コメント


読ませていただきました。
大変参考になりました。
これからも、良い情報の発信をしていだければと思います。
ありがとうございました。

コメントを書く

(ウェブ上には掲載しません)

« ▼ダイエット大作戦(やっと82Kg) | トップページ | ◆E2000Tools(第14回目「ファイル名一括変換」機能) »