広告

AccessVBAでExcelファイルを編集する時は、いちいち「シート」のレベルからCells等を記述しないとエラーになる件

2021.08.21 
AccessからExcelブックにレコードセット貼付後、罫線付与やセル着色でお世話になる、Range(Cells(X,X)，Cells(X,X))による範囲指定ですが、
例えばWorksheet型のオブジェクト変数「ST」に編集対象のワークシートを格納した状態で記述する場合、
×ST.Range(Cells(X,X),Cells(X,X))という書き方だとエラーになることがあります。
○ST.Range(ST.Cells(X,X),ST.Cells(X,X)) この様にCellsの前にも、いちいちシートオブジェクトをつけることでエラーを回避できます
この現象は、Cellsにとどまらず、RowsやColumns、AutoFilterなど、ワークシート上に存在する様々なオブジェクトでも発生する模様！
  • エラーの例としては下図の他に、「Cellsメソッドは失敗しました　Globalオブジェクト」「Rows(Columns)メソッドは失敗しました　Globalオブジェクト」や、「プロシージャの呼び出し、または引数が不正です」などもありました。この先別種に行き会ったら追加していきます。
  • ExcelVBAでやっていた編集作業を、AccessVBAに移植した時には高確率で起こりがち。
  • 「F8」でデバッグ実行している時は大丈夫なのに、ボタンから一気に実行するとエラーになったりするのが地味～に厄介なので気を付けよう！
エラー例）Selectionメソッドは失敗しました Globalオブジェクト

エラー例）インターフェイスがサポートされていません 

＜おまけ兼自分のアンチョコ用＞
◆シートオブジェクトからコッテリ指定しまくったサンプルコード
◆レコードセットをExcelに貼付し、ヘッダ行や罫線等の書式設定して保存するだけのプログラムです。
◆参照設定に「Microsoft Excel XX.X Object Library」を追加する必要があります。

Option Compare Database
Option Explicit

Sub 要注意なCells指定()

Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim R_Cnt As Long

Dim EX As Excel.Application
Dim BK As Excel.Workbook
Dim ST As Excel.Worksheet
Dim F_Name As String

Dim i As Long

'レコードセット開く
Set DB = CurrentDb
’レコード数取得し易いので、便宜上dbOpenTable設定↓で開いてます
Set RS = DB.OpenRecordset("T_出力データ", dbOpenTable)
    R_Cnt = RS.RecordCount
　
’保存ファイル名の準備
F_Name = CurrentProject.Path & "\出力サンプル.xlsx"

'新規Excel＆ブック立ち上げ
Set EX = New Excel.Application
Set BK = EX.Workbooks.Add
Set ST = BK.Worksheets(1)

    'ヘッダをループで書き込む
    For i = 0 To RS.Fields.Count - 1
        ST.Cells(1, i + 1) = RS.Fields(i).Name
    Next i
    '↑このループ終了時、iはフィールド数と同数になっているので↓範囲指定に活用！
    
    '2行目にレコードセットを貼付→閉じる
    ST.Range("A2").CopyFromRecordset RS
    RS.Close

    'セルに罫線を設定(コッテリ①)
    ST.Range(ST.Cells(1, 1), ST.Cells(R_Cnt + 1, i)).Borders.LineStyle = True
    
    'ヘッダに背景色と太字設定(コッテリ②)
    With ST.Range(ST.Cells(1, 1), ST.Cells(1, i))
        .Interior.ColorIndex = 8
        .Font.Bold = True
    End With
    
    '列幅を自動調整(コッテリ③)
    ST.Range(ST.Columns(1), ST.Columns(i)).AutoFit
    
    'ウィンドウ枠の固定(2021/9/4修正)
　　ST.Activate'(2024/6/13追記:Selectでエラーが出る場合は追加してください)
    ST.Range("A1").Select
    With EX.ActiveWindow
        .SplitRow = 1
        .FreezePanes = True
    End With
    
    BK.SaveAs F_Name
    BK.Close
    
Set BK = Nothing
    EX.Quit
Set EX = Nothing

Set RS = Nothing
    DB.Close
Set DB = Nothing

MsgBox "本ツール格納フォルダへ「" & Dir(F_Name) & "」を出力しました。"

End Sub