ExcelVBA ブック関連

自分用のメモなので、形は整ってないです。

ブックを閉じる

Dim wb As Workbook

'Application.DisplayAlerts = False  ブックを保存するかの確認メッセージを出さないようにするならこれで

Workbooks.Open Filename:="C:\work\b111.xlsx", ReadOnly:=True  '読み取り専用で開く
Workbooks.Open Filename:="C:\work\b222.xlsx"
Workbooks.Open Filename:="C:\work\b333.xlsx"
Workbooks.Open Filename:="C:\work\b444.xlsx"
Workbooks.Open Filename:="C:\work\b555.xlsx", ReadOnly:=True

Set wb = ActiveWorkbook  '最後に開いたブックになる
Debug.Print wb.Name   ' b555.xlsx

'Workbooks(1).Close
' 1番目に開いたブックを閉じる(最初に開いたのが自分自身のブックの場合は、自分を閉じてしまう)
Workbooks("b222.xlsx").Close   ' ブック名を指定して閉じる(保存はしない)
Workbooks("b333.xlsx").Close SaveChanges:=True  ' 保存してからブックを閉じる

On Error Resume Next
Workbooks("開いていない.xlsx").Close
If Err.Number <> 0 Then Debug.Print "エラー発生"
On Error GoTo 0

Workbooks.Close
' 開いているブックを全て閉じる(Excelのアプリケーション自体は残る)。自分自身のブックも閉じてしまう

新規ブックを作成する

Dim wb As Workbook
Dim bookPath As String
    
Workbooks.Add   ' 新規ブックを作成する

Set wb = Workbooks.Add  ' 新規ブックを作成して、WorkbookオブジェクトにSET
wb.Worksheets(1).Name = "シート111"

wb.Worksheets(1).Copy   '1番目のシートをコピーして、新規ブックとして切り離す

bookPath = "C:\work\XXX.xlsx"
If Dir(bookPath) = "" Then
  wb.SaveAs bookPath  'ブックの保存
Else
  MsgBox "既に存在するパスなので保存せず"
End If

ブックを開く　　色々と面倒な事が多い。丁寧に進めるべき

Sub eeee()

  Dim openFilePath As String  '開くブックのフルパス
  
  openFilePath = "C:\work\aaa.xlsx"


  ' ブックを開く(フルパス指定)
  Workbooks.Open openFilePath
  Workbooks.Open Filename:=openFilePath


  Workbooks.Open Filename:=openFilePath, ReadOnly:=True
  ' 読み取り専用で開く

  Workbooks.Open Filename:=openFilePath, Password:="readPASS", WriteResPassword:="writePASS"
  ' 読み取りパスワードを"readPASS"、書込みパスワードを"writePASS"で開く

  Workbooks.Open Filename:=openFilePath, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True
  ' ブックのリンクを更新しない、「読み取り専用で開くことを推奨」を無視する(書込みできるように開く)


  ' ※データの書き換えをすると問題があるブックは、以下のように読み取り専用で開くのが手堅い
  Workbooks.Open Filename:=openFilePath, UpdateLinks:=False, ReadOnly:=True

  ' ※データの書き換えをする場合は、以下のようにするのが適当かな
  Workbooks.Open Filename:=openFilePath, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True


  ' ファイルが存在しなかった場合はエラーになるので、その簡易対策
  On Error Resume Next
  Workbooks.Open "C:\work\存在しないブック.xlsx"
  If Err.Number <> 0 Then Debug.Print "エラー発生"
  On Error GoTo 0

  ' ファイルの存在を確認してから開く
  If Dir(openFilePath) <> "" Then
    Workbooks.Open openFilePath
  Else
    MsgBox "ファイルが存在しません。", vbExclamation
  End If

  ' ファイルを選択するダイアログを開く方法
  ' この方法ですでに開いているブックを二重に開いてもエラーにならないのでいいかも
  Dim openFileName As String
  openFileName = Application.GetOpenFilename _
    ("Excel ファイル (*.xls; *.xlsx; *.xlsm; *.xlsb),*.xls; *.xlsx; *.xlsm; *.xlsb")
  If openFileName <> "False" Then
    Workbooks.Open openFileName
  Else
    MsgBox "キャンセルされました"
  End If
  
  
  '開こうとしているブックと同名のブックがすでに開かれている、開くとエラーになる、はず。
  '※明確ではないが、同名のファイルが開いていてもエラーにならないこともある？
  'ただし、新しく開こうとしたブックが開かれないので、事前に同名ファイルが開かれていないかを確認するのは必須
  '以下、同名ブックが開かれていないかの確認、その他の対処
  
  Dim wb As Workbook
  Dim wbTarget As Workbook  '開いて作業するブック
  Dim resultStr As String
  
  
  openFilePath = "C:\work\bbb.xlsx"

  resultStr = SamePath_SameName(openFilePath)
  '同名のブック、同パスのブックが開かれているかを判定する処理を呼び出し
  
  If resultStr = "SamePath" Then
  '開こうとしているブックがすでに開いている場合は、そのブックの作業を続行
    Set wbTarget = Workbooks(Dir(openFilePath))
    If wbTarget.ReadOnly Then
    '読み取り専用で開かれていた場合は、作業をしないという選択もある
      MsgBox "指定のファイルが読み取り専用で開かれています"
      Exit Sub
    End If
    
  ElseIf resultStr = "SameName" Then
  '同名のブックが開かれている場合は、処理を中断
    MsgBox "同名のファイルが開かれています"
    Exit Sub
    
  Else
  '同名、同パスが無ければ、ブックを開く
    Workbooks.Open openFilePath
  End If
  
  
  openFilePath = "C:\work\readOnlyP.xlsx"
  If IsReadOnlyProperty(openFilePath) Then
  'ファイルのプロパティで、読み取り専用になっているかを判定
  '読み取り専用のブックでも、開いて更新のコードはエラーにならない(なるという話も)が、保存しても変更は反映されない
    MsgBox "読み取り専用のブックです"
    Exit Sub
  End If

End Sub


Function SamePath_SameName(openFilePath As String) As String
'pathのExcelファイルが、現在開かれているブックの中に同名のものがあるかと、同じフルパスのものがあるかを判定する
'同名のものが無い場合は "Nothing" を返す
'同名のものがあるが、同パスのものは無い場合は "SameName" を返す
'同パスのものがある場合は "SamePath" を返す

  Dim wb As Workbook
  
  SamePath_SameName = "Nothing"
  
  For Each wb In Workbooks
    If wb.Path & "\" & wb.Name = openFilePath Then ' 同パスのものがある場合
      SamePath_SameName = "SamePath"
      Exit For
    End If
    
    If wb.Name = Dir(openFilePath) Then  ' 同名のものがある場合
      SamePath_SameName = "SameName"
      Exit For
    End If
  Next wb
End Function



Function IsReadOnlyProperty(openFilePath) As Boolean
'pathで指定されたファイルが、読み取り専用属性を持つかを判定する
'読み取り専用で開かれているかを判定するのではないので、注意

  Dim fa As VbFileAttribute  'ファイル属性
  
  fa = GetAttr(openFilePath)  'ファイルの属性を取得

  If (fa And vbReadOnly) = vbReadOnly Then
      IsReadOnlyProperty = True
  Else
      IsReadOnlyProperty = False
  End If
End Function


FileName	開くブックのファイル名。
UpdateLinks	ファイル内の外部参照 (リンク) の更新方法を指定します。
ReadOnly	ブックを読み取り専用モードで開くには、True を指定します。
Format	テキスト ファイルを開く場合は、この引数で区切り文字を指定します。
Password	パスワード保護されたブックを開くのに必要なパスワードを指定します。
WriteResPassword	書き込み保護されたブックに書き込みをするために必要なパスワードを指定します。
IgnoreReadOnlyRecommended	[読み取り専用を推奨する] チェック ボックスをオンにして保存されたブックを開くときでも、読み取り専用を推奨するメッセージを非表示にするには、True を指定します。
Origin	開こうとしているファイルがテキスト ファイルの場合、それがどのような形式のテキスト ファイルかを指定します。
Delimiter	開こうとしているファイルがテキスト ファイルで、引数 Format が 6 の場合は、この引数で区切り文字を使用します。
Editable	開こうとしているファイルが Excel 4.0 のアドインの場合、この引数に True を指定すると、アドインがウィンドウとして表示されます。
Notify	ファイルが読み取り/書き込みモードで開けない場合に、ファイルを通知リストに追加するには、True を指定します。
Converter	ファイルを開くときに最初に使用するファイル コンバーターのインデックス番号を指定します。
AddToMru	最近使用したファイルの一覧にブックを追加するには、True を指定します。既定値は False です。
Local	Excel の言語設定 に合わせてファイルを保存するには、True を指定します。
CorruptLoad	開くモードを、XlCorruptLoad列挙で指定します。
抽出(xlExtractData)、正常(xlnormalload)、修復(xlRepairFile)から指定します。
既定の動作はxlNormalLoadになり、回復は行われません。

ブックを保存する

' 上書き保存
ActiveWorkbook.Save

' 名前を付けて保存
ActiveWorkbook.SaveAs Filename:="C:\work\bbb.xlsx"

ブック関連のイベント

Private Sub Workbook_NewSheet(ByVal Sh As Object)
' 新しいシートを作成した時。引数の"Sh"は、新しく作成したシートになる

  Sh.Move After:=Worksheets(Sheets.Count)
  ' 新規作成したシートを、最後尾に移動する

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
' ブックを閉じる前のイベント。引数の"Cancel"をTrueにすると、ブックを閉じる処理がキャンセルされる

  Dim answer As Long
  
  answer = MsgBox("ブックを閉じます。よろしいですか？", vbYesNo)
  If answer = vbNo Then
    Cancel = True   ' 閉じる処理をキャンセル
    MsgBox "ブックを閉じる処理は中止します"
  End If
    
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' ブックを保存する前のイベント。引数の"Cancel"をTrueにすると、ブックを閉じる処理がキャンセルされる

  If IsNumeric(Cells(1, 1).Value) = False Then  ' セルA1の値が数値に評価できない場合
    Cancel = True
    MsgBox "セルA1の値を数値にしてから、ブックを保存してください"
  End If
    
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' ブック内のいずれかのシートの、セルの値が変更された時に発生する
' 引数の"Sh"は値の変更されたセルのあるシート、引数の"Target"は値の変更されたセル
' アクティブシートが変わった時のイベントではない

  MsgBox Sh.Name
  MsgBox Target.Address

End Sub


Private Sub Workbook_Activate()  ' ブックがアクティブになった時
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)   ' ブックを保存した後
End Sub

Private Sub Workbook_Open()   ' ブックを開いた時
End Sub


Activate	ブック、ワークシート、グラフ シート、または埋め込みグラフがアクティブになったときに発生します。
AddinInstall	ブックがアドインとして組み込まれたときに発生します。
AddinUninstall	ブックのアドインとして組み込みを解除したときに発生します。
AfterSave	ブックが保存された後に発生します。
AfterXmlExport	Microsoft Office Excel がデータを保存するか、指定されたワークブックから XML データをエクスポートした後で発生します。
AfterXmlImport	既存の XML データ接続が更新されたか、または開いている Microsoft Excel ブックに新しい XML データがインポートされた後に発生します。
BeforeClose	ブックを閉じる前に発生します。ブックが変更された場合、ユーザーに変更内容の保存を要求する前に、このイベントが発生します。
BeforePrint	ブックまたはその中に含まれる内容を印刷する前に発生します。
BeforeSave	ブックを保存する前に発生します。
BeforeXmlExport	Microsoft Office Excel がデータを保存するか、指定されたワークブックから XML データをエクスポートする前に発生します。
BeforeXmlImport	既存の XML データ接続が更新されるか、または開いている Microsoft Excel ブックに新しい XML データがインポートされる前に発生します。
Deactivate	グラフ、ワークシート、またはブックが非アクティブになったときに発生します。
NewChart	新しいグラフをブックに作成したときに発生します。
NewSheet	新しいシートをブックに作成したときに発生します。
Open	ブックを開いたときに発生します。
PivotTableCloseConnection	ピボットテーブル レポート接続が閉じた後に発生します。
PivotTableOpenConnection	ピボットテーブル レポート接続が開いた後に発生します。
RowsetComplete	ユーザーが OLAP ピボットテーブルで行セット アクションを起動するか、レコードセットを詳細表示するとイベントが発生します。
SheetActivate	シートがアクティブになったときに発生します。
※すべてのシートが対象となります。
SheetBeforeDoubleClick	既定のダブルクリックの操作の前に、ワークシートをダブルクリックしたときに発生します。
※すべてのシートが対象となります。
SheetBeforeRightClick	既定の右クリックの操作の前に、ワークシートを右クリックしたときに発生します。
※すべてのシートが対象となります。
SheetCalculate	ワークシートを再計算したり、グラフでデータをプロットして変更した後に発生します。
※すべてのシートが対象となります。
SheetChange	ユーザーまたは外部リンクにより、ワークシートのセルが変更されるときに発生します。
※すべてのシートが対象となります。
SheetDeactivate	シートが非アクティブになったときに発生します。
※すべてのシートが対象となります。
SheetFollowHyperlink	Excel のハイパーリンクをクリックすると発生します。ワークシート レベルでのイベントについては、FollowHyperlink イベントのヘルプ トピックを参照してください。
※すべてのシートが対象となります。
SheetPivotTableAfterValueChange	ピボットテーブル内のセルまたはセル範囲が編集または再計算された後に発生します (数式を含むセルの場合)。
※すべてのシートが対象となります。
SheetPivotTableBeforeAllocateChanges	ピボットテーブルに変更が適用される前に発生します。
※すべてのシートが対象となります。
SheetPivotTableBeforeCommitChanges	ピボットテーブルの OLAP データ ソースに対する変更が適用される前に発生します。
※すべてのシートが対象となります。
SheetPivotTableBeforeDiscardChanges	ピボットテーブルに対する変更が破棄される前に発生します。
※すべてのシートが対象となります。
SheetPivotTableChangeSync	ピボットテーブルが変更された後に発生します。
※すべてのシートが対象となります。
SheetPivotTableUpdate	ピボットテーブル レポートのシートが更新された後に発生します。
※すべてのシートが対象となります。
SheetSelectionChange	いずれかのワークシートで選択範囲を変更したときに発生します。選択範囲がグラフ シート上にある場合は発生しません。
※すべてのシートが対象となります。
Sync	ドキュメント ワークスペースに含まれているブックのローカル コピーがサーバー上のコピーと同期されたときに発生します。
WindowActivate	ブックのウィンドウがアクティブになったときに発生します。
WindowDeactivate	ブックのウィンドウが非アクティブになったときに発生します。
WindowResize	ブックのウィンドウ サイズを変更したときに発生します。
AfterRemoteChange	リモートユーザーのブックへの編集が結合された後に発生します。
※Excel2016以降
BeforeRemoteChange	リモートユーザーのブックへの編集が結合される前に発生します。
※Excel2016以降
ModelChange	Excelデータモデルが変更された後に発生します。
※Excel2013以降
SheetBeforeDelete	シートが削除されたときに発生します。
※Excel2013以降
SheetLensGalleryRenderComplete	ワークシートの引き出し線ギャラリーのアイコン(動的および静的)のレンダリングが完了すると発生します。
※Excel2013以降
SheetTableUpdate	シートテーブルが更新された後に発生します。
※Excel2013以降

他のブックのコードを実行する

Sub aaa()

  Application.Run "bbb.xlsm!OtherBookSub"
  ' bbb.xlsm の OtherBookSub() を実行する。PrivateプロシージャでもOK
  ' ※ただし、bbb.xlsmを開いていない場合、開いてから実行されるのがどうも

End Sub

' bbb.xlsm の標準モジュール内にあるコード
Private Sub OtherBookSub()

  MsgBox "bbb.xlsm の OtherBookSub() が呼ばれました"

End Sub

ブックを開かずに、セルの値を取得する。あまり使えない

MsgBox ExecuteExcel4Macro("'C:\work\[bbb.xlsx]シート1'!R1C1")
' C:\まとめ総合\ExcelVBA\bbb.xlsx 「シート1」シート セルA1の値を、ブックを開かずに取得
' セル番地はR1C1形式でしか指定できないので、使いにくい
' セルが空白だった場合、「0」が返るみたい。なお使いにくいな･･･

Dim cellR1C1 As String
Dim i As Long
Dim j As Long

' bbb.xlsx 「シート1」 の Range(Cells(1,1),Cells(5,5)) の値を取得
For i = 1 To 5
  For j = 1 To 5
    cellR1C1 = "R" & i & "C" & j
    Debug.Print ExecuteExcel4Macro("'C:\まとめ総合\ExcelVBA\[bbb.xlsx]シート1'!" & cellR1C1)
  Next j
Next i

' ※面倒なわりに制約も多いから、あまり使えないかな

ブックのフルパスを取得する

Dim wbX As Workbook

For Each wbX In Workbooks
  Debug.Print wbX.FullName  'FullNameでブックのフルパスを取得できる
Next wbX

ブックが既に開かれているかを確認する　　ネットワーク上のブックを誰かが開いているかも判定できる

Sub aaa()

  Dim wbX As Workbook
  Dim bookPath  As String
  
  bookPath = "C:\work\aaa.xlsx"
  
  'ブックが開かれているかを確認するには、一般には以下のような方法が紹介されることが多い
  For Each wbX In Workbooks
    If wbX.FullName = bookPath Then
      MsgBox "既に開かれています"
    End If
  Next wbX
  
  '全てのブックを確認する必要があるので、やや非効率
  'ネットワーク上のブックを誰かが開いていても判定できない
  
  
  '以下のFunctionを使った方法が便利
  Debug.Print IsBookOpened(bookPath)
  
End Sub


Public Function IsBookOpened(ByVal bookPath As String) As Boolean

  On Error Resume Next
  
  Open bookPath For Append As #1  '追加モードでブックを開く。実際にブックが開かれるわけではない
  Close #1
  
  If Err.Number <> 0 Then
    IsBookOpened = True
    'エラーが発生していれば、ブックのOpenに失敗している。他のユーザが既に開いていることになる
  Else
    IsBookOpened = False
  End If

End Function

ブックが、ファイルのプロパティで読み取り専用になっているかを判定する

読み取り専用で開いているか、とは違うので、混同しないように

Sub aaa()

  Dim wb As Workbook
  Dim path As String
  
  path = "C:\work\読み取り専用(プロパティで設定).xlsx"
  path = "C:\work\aaa.xlsx"
  
  MsgBox IsReadOnlyProperty(path)

End Sub


Function IsReadOnlyProperty(path) As Boolean
'pathで指定されたファイルが、読み取り専用属性を持つかを判定する
'読み取り専用で開かれているかを判定するのではないので、注意

  Dim fa As VbFileAttribute  'ファイル属性
  
  fa = GetAttr(path)  'ファイルの属性を取得

  If (fa And vbReadOnly) = vbReadOnly Then
      IsReadOnlyProperty = True
  Else
      IsReadOnlyProperty = False
  End If
End Function

ブックが読み取り専用で開かれているかの判定と、読み取り専用に設定する・解除する方法

Dim wb As Workbook
Dim openFilePath As String

openFilePath = "C:\work\aaa.xlsx"
Workbooks.Open Filename:=openFilePath, ReadOnly:=True  '読み取り専用で開く
Set wb = ActiveWorkbook

If wb.ReadOnly Then   ' 読み取り専用で開いているかを判定
Call wb.ChangeFileAccess(xlReadWrite)
'標準APIらしい。xlReadWriteで読み取り専用を解除
MsgBox "読み取り専用だったので、解除しました"

Else
Call wb.ChangeFileAccess(xlReadOnly)
MsgBox "読み取り専用ではなかったので、読み取り専用にしました"
End If


'読み取り専用の設定を変更する前に、保存済みであるかを確認するのもいい
If wb.Saved Then   '保存されている場合
Call wb.ChangeFileAccess(xlReadWrite)
Else
MsgBox "未保存なので、読み取り専用にはしません"
End If

新規ブックとして作成したブックが保存されているかを判定する

Worksheets(Worksheets.Count).Copy  '末尾のシートを新規ブックとしてコピー

If (InStr(1, ActiveWorkbook.FullName, "\") > 0) Then
'FullName で新規ブックのパスを取得。.Pathでは取得できないので注意
'新規ブックのパスには、「\」が入っていないので、この段階では未保存と判定される
  Debug.Print "保存済み"
Else
  Debug.Print "未保存"
End If

Worksheets(Worksheets.Count).Copy
ActiveWorkbook.SaveAs Filename:="C:\work\abc.xlsx"

If (InStr(1, ActiveWorkbook.FullName, "\") > 0) Then
'この段階では保存済みと判定される
  Debug.Print "保存済み"
Else
  Debug.Print "未保存"
End If

VBAでブックを開く時の注意点　　パスは違う同名のブックを開いてあるとトラブルの元なので、それだけでも確認を

Sub aaa()

'"C:\work\AAA\aaa.xlsx" と "C:\work\BBB\aaa.xlsx" が存在するとする

'"C:\work\BBB\aaa.xlsx"を開いた状態で、以下のコードを実行

Dim wb As Workbook
Dim bookPath As String

bookPath = "C:\work\AAA\aaa.xlsx"

Workbooks.Open Filename:=bookPath, ReadOnly:=True  '読み取り専用で開く
Set wb = ActiveWorkbook
Debug.Print wb.Worksheets(1).Name
'これは"C:\work\AAA\aaa.xlsx"の第一シート名を取得するはずだが、"C:\work\BBB\aaa.xlsx"のシート名が取得される

wb.Close  'これは"C:\work\BBB\aaa.xlsx"が閉じられる
Set wb = Nothing

'ブックを開こうとしている時に、パスの違う同名のファイルが開かれている場合は、そちらが対象になってしまうようだ
'"C:\work\BBB\aaa.xlsx"が開かれていない場合は、"C:\work\AAA\aaa.xlsx"のシート名が取得される
'ブックを開く時は、同名のブックが開かれていないかを必ず確認すること

End Sub


読み取り専用推奨のブックを、VBAで読み取り専用を無視して開くと、VBAコードのあるブックを開いている間は、読み取り専用推奨のブックを開く時に読み取り専用推奨のメッセージが出ない?
VBAコードのあるブックを閉じた後に読み取り専用推奨のブックを開くと、メッセージは出るが。
本当か?


ファイルのプロパティで読み取り専用のブックをVBAで開き、内容を変更して保存すると、特にエラーにはならないが変更は反映されないようだ


あるブックをVBAでOpenした時、すでに同名のブック(パスは異なる)が開かれていると、エラーにはならずOpenしようとしたブックは開かれないらしい。事前に同名のブックが開かれていないかを確認する必要があるかも
同じパスのブックがすでに開いてある場合に、そのブックをさらにOpenしても、エラーにはならないようだが。
手動で同名のブックを開こうとするとエラーになるが、VBAでは開いてしまう?　VBAでも同名ブックを開くとエラーになるはずだが?