広告

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

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