こんにちは。
今回は、参照設定にてxla,xlamアドインファイルの追加と解除を行うマクロを紹介します。
■事前準備
参照設定にてxla,xlamアドインファイルを扱う際に以下のようなメッセージが出力されて、取り込めない場合があります。
「実行時エラー ‘1004’: ‘VBProject’ メソッドは失敗しました: ‘_Workbook’ オブジェクト」
その為、事前に1ヶ所だけExcelの設定を変更します。今回はExcel2016を使用して説明します。
- Excelの画面の左上、「ファイル」タブを選択する。
- 左下の「オプション」タブを選択する。
- 「Excelのオプション」ウィンドウにて、左下の「セキュリティ センター」を選択。
- 右側「Microsoft Excel セキュリティ センター」の「セキュリティ センターの設定(T)…」ボタンをクリックする。
- 「セキュリティ センター」ウィンドウにて、左側中央付近の「マクロの設定」を選択。
- 右側「開発者向けのマクロの設定」の、「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する(V)」にチェックを入れる。
■コード
以下の場合にエラーが出力されるようになっています。
- UFPathとして設定されているファイルが存在しない。
- 参照設定にて参照不可のライブラリが存在する。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
Option Explicit Public Const UFPath As String = "拡張子付きファイルパス" Public Const FunctionName As String = "プロジェクト名" '参照設定ファイル設定 Function Set_Ref() As Boolean 'ファイルが存在しない場合 If Dir(UFPath) = Empty Then MsgBox UFPath & " が存在しません。", vbCritical Exit Function End If '参照設定解除 Call Rem_Ref '参照設定 ThisWorkbook.VBProject.References.AddFromFile UFPath Set_Ref = True End Function '参照設定解除 Sub Rem_Ref() '参照設定名前一致確認 If Not RefCheck Then Exit Sub With ThisWorkbook.VBProject .References.Remove .References(FunctionName) End With On Error Resume Next '参照設定していたファイルを閉じる Application.EnableEvents = False Workbooks(Dir(UFPath)).Close False Application.EnableEvents = True On Error GoTo 0 End Sub '参照設定名前一致確認 Function RefCheck() As Boolean Dim Ref With ThisWorkbook.VBProject '全ての参照設定 For Each Ref In .References If Ref.IsBroken Then MsgBox "参照不可のライブラリがあります。", vbCritical Exit Function '名前が一致する場合 ElseIf Ref.Name = FunctionName Then RefCheck = True End If Next Ref End With End Function |
■使い方(使用例)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
Option Explicit 'ファイルを開いたときに自動で動かすマクロ Private Sub Workbook_Open() If Set_Ref Then Exit Sub Msgbox UFPath & "が存在しません。処理を中止します。", vbCritical If Workbooks.Count <= 1 Then Application.Quit ThisWorkbook.Close False End End Sub 'ファイルを閉じる直前に自動で動かすマクロ Private Sub Workbook_BeforeClose(Cancel As Boolean) With ThisWorkbook Select Case MsgBox(.Name & " を保存しますか?", vbInformation + vbYesNoCancel, .Name) '保存する Case vbYes Call Rem_Ref .Save .Saved = True If Workbooks.Count <= 1 Then Application.Quit '保存しない Case vbNo Call Rem_Ref .Saved = True If Workbooks.Count <= 1 Then Application.Quit 'キャンセル Case vbCancel Cancel = True End Select End With End Sub |
---コメント---