Access VBAでExcelファイルを操作する

2021年2月2日2022年5月3日

SBMJOB

Accessでテーブルを使いながら何かしらの情報を管理しつつExcelファイルの操作を行いたいことってあるますよね。簡単な請求書や納品書のExcle出力等や簡単なExcelファイルの一部セルのチェックや書き換え。そんな時のAccessVBAからExcelファイルの操作方法をご紹介します。

基本パターン

デスクトップにあるsampleExcel.xlslのすべてのシートをループ処理する基本サンプルです。

この例では固定のファイルを使っていますがここを工夫すれば応用範囲が広がるでしょう。

肝心なExcelシートの処理自体はFor Eachの中で処理されています。この中ではPrintOutしていますのですべてのシートをプリントアウトします。大量のExcelファイルを印刷したりPDF化したい場合はこのサンプルコードを変更していけば作り上げることができますね。

Public Sub excelSample()
    Dim xlApp As Object 'Excelアプリ'
    Dim xlBook As Object 'Excelブック'
    Dim xlSheet As Object 'Excelシート'

        
    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("C:\Users\xxxxxxx\Desktop\sampleExcel.xlsx")
    Set xlSheet = xlBook.Worksheets("Sheet1")

        
        ' ブックの全シートを 1 つずつループして処理する
        Dim objSheet As Worksheet
            For Each objSheet In xlBook.Worksheets
                Debug.Print objSheet.Name & "を処理します"
    
                'A1セルにシートの名前を書き込む
                objSheet.Cells(1, 1) = "このシートの名前は" & objSheet.Name & "です。"
                'シートを印刷する。
                objSheet.PrintOut
            Next
        

'    Set rs = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

パスを受けとて処理する関数化

このサンプルコードではExcleファイルのフルパスを受け取ってそのファイルを開き、すべてのシートを処理するサンプルとなっています。

サンプルなので処理内容は無意味なのですが、メッセージボックスでセルの内容を表示したり、背景色を変更したり、ShrinktoFitでセルの幅を調整したりしています。この辺りを書き換えれば請求書等での見切れ対応等を組み込む事ができます。

Private Sub dispExcelData(ByVal recievedFullPath As String)
    Dim xlApp As Object 'Excelアプリ'
    Dim xlBook As Object 'Excelブック'
    Dim xlSheet As Object 'Excelシート'

    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = False
        xlApp.Application.DisplayAlerts = False
    Set xlBook = xlApp.Workbooks.Open(recievedFullPath)
    'Set xlSheet = xlBook.Worksheets("Sheet1")

        
        ' ブックの全シートを 1 つずつループして処理する
        Dim objSheet As Object
        Dim rng As Object
            For Each objSheet In xlBook.Worksheets
                objSheet.Activate
                Debug.Print objSheet.Name & "を処理します*****************"
                
                Set rng = objSheet.range("A1:B6")
                Dim vnt As Variant
                vnt = rng.Value
                
                Dim msg As String
                Dim x As Integer
                Dim i As Long
                msg = ""
                For x = 1 To UBound(vnt)
                    msg = msg & vnt(x, 1) & " " & vnt(x, 2) & vbCrLf
                Next
                MsgBox msg
                Dim testString As String
                testString = objSheet.range("B2").Value
                MsgBox testString
                testString = objSheet.range("B3").Value
                MsgBox testString
                testString = objSheet.range("B4").Value
                MsgBox testString
                testString = objSheet.range("B5").Value
                MsgBox testString
                
                objSheet.range("B2").Value = "cccc"
                objSheet.range("B2").interior.colorindex = 4
                objSheet.range("A6").ShrinkToFit = True
                Debug.Print objSheet.Name & "を処理終了*****************"
                 
            Next objSheet
        
 

    'xlApp.Quit
    
    xlBook.Save
    xlApp.Application.DisplayAlerts = True
    xlBook.Close
    xlApp.Quit
'    Set xlSheet = Nothing
'    Set xlBook = Nothing
'    Set xlApp = Nothing
    
   
End Sub