※Excelのバージョンによって、VBA、マクロの命令が違います。
2010で作成したマクロは2003で動作しません。(97-2000互換ファイル形式でも互換しません)
開発時は、なるべく2003を使用しましょう。
関数も2003では使えないものが多数ありますので、確認すること。
■アクセスVBAからExcelを操作の基本準備
Dim XLA As Object
Dim XLB As Object
Dim XLS As Object
Set XLA = CreateObject("Excel.Application")
Set XLB = XLA.Workbooks.Open("C:\ファイル名.xls") '←既存ファイルOpen時
'Set XLB = XLA.Workbooks.add '←新規ファイル作成時
If XLB.ReadOnly = True Then
MsgBox "目的のファイルは使用中なので書き込めません。",vbOKOnly
XLB.Close False
XLA.Quit
Set XLB = Nothing
Set XLA = Nothing
Exit Sub
End If
Set XLS = XLB.Worksheets("Sheet1") 'XLA.ScreenUpdating = False '描画をSTOPして高速化
XLA.Visible = False 'エクセルを画面に表示しない
XLS.Activate '操作シートをアクティブにする
■シートの操作例
'=======操作対象のシートをアクティブ(シートが存在しない場合はシート作成後)=======
WSC = XLB.worksheets.Count '現在のワークシートの数
J = 0: For I = 1 To WSC
If XLB.worksheets(I).Name = ES Then J = 1
Next I
If J = 0 Then 'もし、対象シートが存在しないのであれば…
Set XLS = XLB.worksheets.add(after:=XLB.worksheets(WSC)) 'シートの最後に新しいシート作成
XLB.ActiveSheet.Name = ES 'シート名をESに変更
End If
Set XLS = XLB.worksheets(ES)
XLS.Activate '対象シートをアクティブにする
:
■シート全体をクリア
XLS.Cells.Value = ""
XLS.Cells.Clear '値、罫線、背景色、書式等をクリア
XLS.Cells.ClearContents '数式と文字だけをクリア
XLS.Cells.ClearFormats '罫線、背景色、書式、フォント、配置などの書式設定を標準に戻す
■セルに値を代入する例
XLS.Range("S7:S44").Value = "A"
XLS.Range("S7").Value = "A"
XLS.Cells(SY + 6, SX + 3).Value = "A"
XLS.Cells("E", SX + 3).Value = "A"
XLS.Range("S7:S44").Offset(2 , 4).Value = "A"
※offsetの注意!: 始点セルが結合されている場合、結合範囲の最後のセル(右下)から数えるので注意が必要
■セル番地の変換
XLS.Range("B4").Column …横(アルファベット)を数値へ変換⇒2
XLS.Cells( 4 , 5 ).Address ⇒ "$E$4"
■結合セル関係
XLS.Range("B4").MergeArea.CELLS(1, 1) …B4を含む結合セルの左上
XLS.Range("B4").MergeArea.Columns.Count …B4を含む結合セルの横のセル数 (縦は、Rows)
■配列変数内をまとめてセルに記入
DIM CB()
ReDim CB(5,2)
XLS.Range(XLS.cells(2, 3), XLS.Cells(7, 5)).Value = CB 'CBは配列変数
■Excel関数をセルに記入の例
XLS.Cells(SY + 6, SX + 3).Value = "=count(R[1]C[0]:R[" & coy & "]C[0])"
■シート内でのセルコピーの例
XLS.cells(SY + 6, SX + 3).Copy 'Copy,Cut,Past
XLS.range(XLS.cells(SY + 6, SX + 3), XLS.cells(SY + 6, SX + 3 + cox - 1)).Select
XLS.Paste
■指定セルにカーソルを移す
XLS.range("A1").Activate
■ブックを保存して終了
On Error Resume Next
XLA.Visible = False
XLA.ScreenUpdating = True
If Dir("C:\ファイル名.xls") <> "" Then
XLB.Save
Else
If XLA.Version < 12 Then '2007より低いVerかどうか調べる
XLB.SaveAs "C:\ファイル名.xls"
Else
XLB.SaveAs "C:\ファイル名.xls", FileFormat:=56 '97-2003形式で保存
End If
End If
XLB.Close False '(True=保存、Flase=破棄)
XLA.Quit
Set XLS = Nothing
Set XLB = Nothing
Set XLA = Nothing
■シートを印刷/プレビュー
XLS.PrintOut
XLS.PrintPreview
■セル周辺に罫線を引く
XLS.Range("A1:C4").BorderAround 種類値 , 太さ値 , , RGB値
種類値
太さ値
実線 1 極細線 1 破線 -4115 細線 2 1点鎖線 4 中線 -4138 2点鎖線 5 太線 4 点線 -4118 二重線 -4119 なし -4142 斜点線 13
■セルに罫線を引く
XLS.Range("A7:C10").Borders.LineStyle = 1 '種類値
XLS.Range(XLS.cells(2, 3), XLS.Cells(7, 5)).Borders.Weight = 1 '太さ
XLS.Range("b7:C10").Borders(場所値).LineStyle = 1 '←(場所値を指定すると一部だけに線を引く)
場所値
上 8 下 9 左 7 右 10 内横 12 内縦 11 左斜め 5 右斜め 6
■セル内文字配置(縦、横)の設定
XLS.Range("A1:C4").VerticalAlignment = 値 '縦位置
XLS.Range("A1:C4").HorizontalAlignment = 値 '横位置
縦位置値
横位置値
上 -4160 標準 1 中央 -4108 左 -4131 下 -4107 中央 -4108 均等 -4117 右 -4152 両端 -4130 選択中央 7 均等 -4117 両端 -4130 繰り返し 5
■行/列の高さ取得/設定
XLS.Range("A1:C4").RowHeight = ポイント数
XLS.Columns(1).ColumnWidth = ポイント数
■セルの結合
XLS.Range("A1:A2").MergeCells = True
■セル内の文字列を折り返す
XLS.Range("A1:C4").WrapText = True
■セル内の文字を縮小
XLS.Range("A1:C4").ShrinkToFit = True
■セルの表示形式の設定
XLS.Range("A1:A2").NumberFormat = "yyyy" & chr(34) & "年" & chr(34) 'chr(34)はダブルクォーテーション
■広範囲セルを選択
XLS.Range("A1:E7").Select
■色、フォントの設定
XLS.Range("A1:E7").Font.Color = RGB値 'フォントカラー
XLS.Range("A1:E7").Interior.Color = RGB値 '背景カラー (-4142)
XLS.Range("A1:E7").Interior.ColorIndex = -4142 '背景カラー無しに設定
XLS.Range("A1:E7").Font.Name = "MS UI Gothic" 'フォント変更
XLS.Range("A1:E7").Font.Size = 12 'フォントサイズ変更
XLS.Range("A1:E7").Font.Bold = True '太字へ変更 (.Italicで斜体)
■セルの書式を設定する
XLS.Range("E7").NumberFormatLocal = "0.0" '小数点第1位まで表示
■セルの文字方向を縦書きにする
XLS.Range("E7").Orientation = -4166 '-4166で縦書き、0で標準、-90〜90で回転
■セル 幅、高さを取得、設定
XLS.Columns(i).ColumnWidth = ’セル幅設定
XLS.Rows(i).RowHeight = ’セル高さ設定
■行毎コピー貼り付け
XLS.Range(XLS.Rows(1), XLS.Rows(7)).Copy '1行〜7行までをコピー(列はColumns)
XLS.Cells(8 , 1).Select 'A8を選択
XLS.Paste '貼り付け
XLA.CutCopyMode = False 'コピーエリア解除
■置換
XLS.Range(XLS.Rows(Y), XLS.Rows(Y+3)).Replace What:="あ", replacement:="い" '置換
■ワークシートの数、ワークシートの名前取得
= XLB.Worksheets.Count 'ブック内のワークシートの数
= XLB.Worksheets(i).Name 'ワークシートの名前 i=1以上
■現在使用されている最大セル 番地の取得
= XLS.UsedRange.Rows.Count + XLS.UsedRange.Row - 1 '縦
= XLS.UsedRange.Columns.Count + XLS.UsedRange.Column - 1 '横
※セルが変更されてなくても、セル幅や高さが変更されている番地も含まれる
■シート全体を別なブックへコピー
Dim XLA As Object
Dim XLB1 As Object
Dim XLB2 As Object
Dim XLS1 As Object
Set XLA = CreateObject("Excel.Application")
Set XLB1 = XLA.Workbooks.Open("C:\ファイル名1.xls")
Set XLS1 = XLB1.Worksheets("Sheet1")
Set XLB2 = XLA.Workbooks.Open("C:\ファイル名2.xls")
XLS1.Copy before:=XLB2.Worksheets(1)
※1つのエクセルアプリケーションを起動し,その中で2つのブックを開くこと。2つのエクセルアプリ間でのシートコピーはエラーになる。
■改ページ設定
XLS.Cells.Select
XLS.ResetAllPageBreaks '全ての改ページをクリア(設定前に実行)
XLS.HPageBreaks.Add Before:=Range("A64") ’A64までで改ページ(繰り返し複数設定できる)
XLS.HPageBreaks.Add Before:=Cells(i, 1) ’変数iまでで改ページ ActiveWin
dow.View = xlPageBre akPreview ’改ページ表示モード
■システムメッセージ
XLA.DisplayAlerts = False 'エクセルのメッセージを表示しない
■一連の例
Dim FN, DN, SN, I, J, C
SN = "書き込むシート名"
DN = "保存ファイル名"
FN = Y_GetSaveFileDialog("保存ファイルの場所と名前を指定してください。", DN)
If FN = "" Then Exit Sub
If LCase(Right(FN, 4)) <> ".xls" Then FN = FN & ".xls"
If Dir(FN) <> "" Then
If MsgBox("上書きしますか?", vbDefaultButton2 + vbOKCancel, "<<上書き確認>>") = vbCancel Then Exit Sub
End If
Dim XLA As Object
Dim XLB As Object
Dim XLS As Object
Set XLA = CreateObject("Excel.Application")
If Dir(FN) <> "" Then
Set XLB = XLA.Workbooks.Open(FN)
If XLB.ReadOnly = True Then
MsgBox "目的のファイルは使用中なので書き込めません。", vbOKOnly
XLB.Close False
XLA.Quit
Set XLB = Nothing
Set XLA = Nothing
Exit Sub
End If
J = XLB.Worksheets.Count: C = 0
For I = 1 To J
If XLB.Worksheets(I).name = SN Then C = 1: Exit For
Next I
If C = 1 Then
Set XLS = XLB.Worksheets(SN)
XLS.Cells.Clear
Else
Set XLS = XLB.Worksheets.add(after:=XLB.Worksheets(J))
XLB.ActiveSheet.name = SN
Set XLS = XLB.Worksheets(SN)
End If
Else
XLA.SheetsInNewWorkbook = 1
Set XLB = XLA.Workbooks.add
Set XLS = XLB.Worksheets(1)
XLB.Worksheets(1).name = SN
End If
XLA.ScreenUpdating = False '描画をSTOPして高速化
XLA.Visible = False 'エクセルを画面に表示しない
XLS.Activate '操作シートをアクティブにする
'===================================================
XLS.Range("A1:E10").Value = "A" 'シートに書き込む処理等を記入
'===================================================
On Error Resume Next
XLA.Visible = False
XLA.ScreenUpdating = True
If Dir(FN) <> "" Then
XLB.Save
Else
If XLA.Version < 12 Then '2007より低いVerかどうか調べる
XLB.SaveAs FN
Else
XLB.SaveAs FN, FileFormat:=56 '97-2003形式で保存
End If
End If
XLB.Close False
XLA.Quit
Set XLS = Nothing
Set XLB = Nothing
Set XLA = Nothing
MsgBox "書き込み処理終了しました。", , "<<完了>>"
■一連の例
Dim FN, DN, N, QN
QN = "書き込むテーブル名orクエリー名" '⇒ シート名になる
DN = "保存ファイル名"
FN = Y_GetSaveFileDialog("保存ファイルの場所と名前を指定してください。", DN)
If FN = "" Then Exit Sub
If LCase(Right(FN, 4)) <> ".xls" Then FN = FN & ".xls"
If Dir(FN) <> "" Then
If MsgBox("上書きしますか?", vbDefaultButton2 + vbOKCancel, "<<上書き確認>>") = vbCancel Then Exit Sub
End If
Dim XLA As Object
Dim XLB As Object
If Dir(FN) <> "" Then
Set XLA = CreateObject("Excel.Application")
Set XLB = XLA.Workbooks.Open(FN)
If XLB.ReadOnly = True Then
XLB.Close False
XLA.Quit
Set XLB = Nothing
Set XLA = Nothing
MsgBox "目的のファイルは使用中なので書き込めません。", vbOKOnly, "<<中止>>"
Exit Sub
Else
XLB.Close False
XLA.Quit
Set XLB = Nothing
Set XLA = Nothing
End If
End If
On Error GoTo 0
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, QN, FN
MsgBox "エクスポート完了しました。", , "<<完了>>"
Exit Sub
e:
MsgBox "エクスポート出来ませんでした。", , "<<失敗>>"
=========Excel から Accessのデータベースを操作する=========
■ExcelからAccessのテーブル(クエリ)を読み込む例
Dim db As Database
Dim tb As Recordset
Set db = DBEngine.Workspaces(0).OpenDatabase(ActiveWorkbook.Path & "\testDB.mdb")
Set tb = db.OpenRecordset("Query1")
Do Until tb.EOF
Debug.Print tb!氏名
tb.MoveNext
Loop
tb.Close
db.Close
Set tb = Nothing
Set db = Nothing
※ExcelのVBエディタの参照設定に『Microsoft DAO 3.6 Object Library』を追加(チェックを入れる)しておくこと。
( VBAエディタ[Alt]+[F11] ⇒ ツール ⇒ 参照設定 )