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

MSACCESS_eyecatch
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

参考にさせていただいたサイト

スポンサーリンク

よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!

この記事を書いた人

システム開発SE・アプリ開発・デバッガー等々なんでもやる猫の下僕です。現在は凶暴猫にカタカタ動く手を狙われながらキーボードを打っています。かなりゆるい性格なのでコメントやメッセージお気軽に〜お仕事のご依頼もお気軽にぃ〜

スポンサーリンク

コメント

コメントする

CAPTCHA


目次