はじめに
エクセルでは外部のブックリンクが存在する場合、ファイルを開く際に「セキュリティ警告 リンクの自動更新が無効にされました」と表示されることがある。
もしくは、以下の画像のように、「このブックには、安全ではない可能性のある外部ソースへのリンクが1つ以上含まれています。」と表示されることもある。
外部のブックリンクを使用して、データを取得していることが分かっているのであれば、有効化・更新すればよいのだが、そのつもりがないのに、毎回、このメッセージが表示され、一体、どこに外部のブックリンクがあるのか分からず、困ってしまうことがある。
そのため、Excel VBAを使って、外部のブックリンクの設定されている場所を探す方法について考えてみたい。
ブックリンクがありそうな場所について
ブックリンクの設定されている場所を探すにあたって、まず、ブックリンクがありそうな場所を特定する必要がある。今までの経験則や、今回、あれこれ試してみた結果、以下の８項目をありそうな場所として特定した。
① セル内の数式
② 名前定義
③ 入力規則
④ 条件付き書式
A.セルの値
B.特定の文字列
C.カラースケール
D.アイコンセット
E.データバー
F.数式
⑤ 図形のセル参照
⑥ 図形のマクロ登録
⑦ グラフタイトル、グラフ軸ラベルタイトル、グラフ軸/系列範囲
A.グラフタイトル
B.グラフ軸タイトル
C.グラフ軸/系列範囲
⑧ フォームコントロールのリンクするセル/入力範囲
これ以外にもあり得るかもしれないが、今回はこの8項目を検索したいと思う。
また、テーブルやピボットテーブル、クエリといったデータ接続は「セキュリティ警告 外部データ接続が無効になっています」と表示されるため除外した。
《テーブル・ピボットテーブル・クエリによるデータ接続の場合》
作成したマクロの概要
標準モジュールに、メインのプロシージャとメインプロシージャから呼び出す上記で特定した8項目を検索するプロシージャ、出力シートに出力するプロシージャを作成した。
- メインプロシージャ「FindExternalLinks」
- 各項目を検索するプロシージャ
① セル内の数式を検索「SearchCells」
② 名前定義を検索「SearchNames」
③ 入力規則を検索「SearchValidation」
④ 条件付き書式を検索「SearchFormatConditions」
⑤ 図形・グラフ・フォームコントロールを検索
A. ループ用プロシージャ「SearchShapes」
B. 処理用プロシージャ「SerchShapeProcess」
C. 入力規則のドロップダウン除外用Functionプロシージャ「DropdownChack」 - 出力シートに出力するプロシージャ「OutputProcess」
動作手順
《メインプロシージャ「FindExternalLinks」》
- 出力シートを初期化
- ブックリンクの設定場所を検索したい対象のブックをリンクを更新せずに開く
- 非表示になっているシートがある場合、表示させる
- 設定されているブックリンクのフルパスを取得
- 取得したブックリンクのフルパスからファイル名を抜き出し、検索用リストを作成
- リンクしている外部のブックを開いている場合、セル内の数式のブックリンクの表示がフルパスではなく、ファイル名だけになるため、ファイル名のみで検索する
- ファイル名が同じで、保存フォルダが違う場合、ブックリンクの情報を1件ずつファイル名のみで検索した場合、処理が重複してしまうため、Dictionaryオブジェクトで検索用リストを作成し、ファイル名の重複を除いた
- 作成した検索用リストのファイル名を各項目の検索用プロシージャを呼び出して検索
《セル内の数式を検索「SearchCells」》
- 各シートにフィルタの絞り込みがある場合は解除、非表示セルがある場合は表示させる
- 各シートごとのセル内を検索
- 数式を対象に部分一致でファイル名を検索する
- ブックリンクの場合、セルには数式が入力されており、ファイル名が”[]”で囲まれるため、見つかったセルのうち、数式となっているセルで、”[”を含むセルを対象としている
- 見つかった場合、そのシートの最初に見つかったセルを記録
- 見つかった場所についての情報を出力
- FindNextメソッドを使って次への検索を繰り返し、見つかったら情報を出力
- 最初に見つかったセルへ戻ったら終了
《名前定義を検索「SearchNames」》
- 非表示になっている名前定義がある場合、表示させる
- 対象のブックの名前定義を検索
- 見つかった場合、その名前定義の情報を出力
《入力規則を検索「SearchValidation」》
- 入力規則の設定範囲記録用リストとしてDictionaryオブジェクトを作成
- 「On Error Resume Next」でエラーが発生しても止まらずに先へ進むようにする
- シートごとに、Specialcellsメソッドを使い、入力規則の設定のあるセルの数を変数へ入れる
- 入力規則がない場合、Specialcellsメソッドはエラーとなり、変数は0で先へ進む
- 変数が0ではない場合、入力規則が設定されているセルごとに処理を行う
- 入力規則が設定されているセルと同じ入力規則のセルをSpecialcellsメソッドを使って取得
- 取得した設定範囲が設定範囲記録用リストにない場合、Dictionaryオブジェクトに追加
- 設定範囲の先頭のセルの入力規則を変数に入れて処理
- 取得した設定範囲に結合セルがある場合、結合セルの先頭のみに入力規則が設定され、結合された他のセルには設定がなく、設定があるセルとないセルが混ざった範囲となり、設定範囲全体の入力規則を取得しようとするとエラーになるため、先頭のセルの入力規則を使って処理を行う
- 追加した設定範囲の入力規則にファイル名があるか確認、ある場合、入力規則の情報を出力
- 入力規則のうち、Operatorプロパティが、「～の間」、「～の間以外」の場合、Formulaプロパティに加え、Formula2プロパティも確認する
《条件付き書式を検索「SearchFormatConditions」》
条件付き書式については、確認した所、外部のブックリンクを設定できそうな種類は、以下の通りだった。- 指定の値を含むセルだけを書式設定
「セルの値」、「特定の文字列」 - セルの値に基づいて全てのセルを書式設定
「カラースケール」、「アイコンセット」、「データバー」 - 数式を使用して、書式設定するセルを決定
「数式」
種類ごとに検索する場所が違うため、種類ごとの処理を行った。
- シートごとに条件付き書式を検索
- セルの値、特定の文字列、数式の場合、Formulaプロパティを検索
- セルの値で、Operatorプロパティが、「～の間」、「～の間以外」の場合、Formula2プロパティも検索
- カラースケールの場合、ColorscaleCriteriaオブジェクトの各ItemのValueプロパティを検索
- アイコンセットの場合、IconCriteriaオブジェクトの各ItemのValueプロパティを検索
- データバーの場合、MaxPoint、MinPointプロパティで取得できるConditionValueオブジェクトのValueプロパティを検索
《図形・グラフ・フォームコントロールを検索》
A. ループ用プロシージャ「SearchShapes」
- Shapesオブジェクトには、グラフ・フォームコントロールも含まれる
- 非表示になっている図形がある場合、表示させる
- シートごとに各図形に対して、処理用プロシージャを呼び出して処理
- フォームコントロールのラベル・グループボックス用のチェックシートを作成している場合、最後に削除する
B. 処理用プロシージャ「SerchShapeProcess」
- グループ化された図形に対しては、ShapeオブジェクトのGroupItemsプロパティで取得できるGroupShapesオブジェクトの各Itemに対して、処理用プロシージャの再帰処理を行う
- グラフの場合、グラフタイトル、グラフ軸タイトル、グラフ軸/系列範囲も検索する
- フォームコントロールのラベル・グループボックスの場合、セル参照の設定がFormulaプロパティに存在しないため、別処理を行う（処理内容は下記の苦労した点に記載）
- ラベル・グループボックス・ボタンを除くフォームコントロールの場合、リンクするセルを検索、さらに、リストボックス・ドロップダウンの場合には、入力範囲も検索する
※「ドロップダウン」とは「コンボボックス」のこと。コード内ではDropdownと表記されているため、ドロップダウンと表記している。
- 図形のセル参照は、ShapeオブジェクトのDrawingObjectプロパティで取得できる各オブジェクトのFormulaプロパティを確認
- 図形のマクロ登録は、ShapeオブジェクトのOnActionプロパティを確認
図形によっては、Formula、OnActionプロパティが存在せず、エラーとなる場合がある。そのため、On Error Resume Nextを使い、エラーが発生しても止まらずに先へ進むようにしておく。Formula、OnActionプロパティの値を取得して変数に入れる処理で、プロパティが存在しない場合はエラーとなるが、変数は空白のまま先へ進む。そこで、変数が空白ではない(プロパティが存在しており、値が入っている)場合のみ、検索する対応とした。
C. 入力規則のドロップダウン除外用Functionプロシージャ「DropdownChack」
- WorksheetオブジェクトのDropDownsメソッドで取得できるDropDownsオブジェクトはフォームコントロールのドロップダウンのみであることを利用し、確認したい図形の名前がDropDownsオブジェクトの各DropDownオブジェクトの名前と一致する場合は、フォームコントロールのドロップダウンであると判断しTrueを返す
Shapesオブジェクトで処理を行うと、入力規則のドロップダウンも図形として処理されてしまい、フォームコントロールのドロップダウンと区別がつかず、エラーが発生してしまった。そのため、入力規則のドロップダウンを除外するため、フォームコントロールのドロップダウンの場合Trueを返すFunctionプロシージャ「DropdownChack」を作成した。
※「OutputProcess」プロシージャについての説明は割愛
苦労した点
作成に当たって、悩んだのが、フォームコントロールの「ラベル」、「グループボックス」について、「セル参照」が設定できるにもかかわらず、「Formulaプロパティ」が存在しないという問題だった。
ローカルウィンドウをくまなく探しながら、ようやく見つけたのが、DrawingObjectsオブジェクトにおいて、そのシートに1つだけラベルもしくはグループボックスがある場合、「DrawingObjectsオブジェクト」の「LinkedCellプロパティ」が、そのラベル・グループボックスの「セル参照」の値になっていることを発見した。
そのため、フォームコントロールの「ラベル」、「グループボックス」の「セル参照」の確認については、チェック用の新規シートを作成し、該当するフォームコントロールをコピーして、新規シートに貼り付け、「DrawingObjectsオブジェクト」の「LinkedCellプロパティ」を確認し、その後、作成したシートを削除する処理とした。
完成したマクロ
前提として、ブックリンクの設定されている場所を検索したいファイルのフルパスが、「設定」シートのB2セルに入力されており、検索結果は「出力」シートに出力する仕様とする。
《設定シート》
《出力シート》
作成モジュール
Private TargetBook As Workbook
Private TargetFileName As String
Private OutputSheet As Worksheet
Private ChackSheet As Worksheet
Public Sub FindExternalLinks()
Dim i As Long
Dim myLinkSources As Variant
Dim Fso As Object
Dim myDic As Object
Application.ScreenUpdating = False
Set OutputSheet = ThisWorkbook.Sheets("出力")
OutputSheet.Range("A1").CurrentRegion.Offset(1).ClearContents
Set TargetBook = Workbooks.Open(Filename:=ThisWorkbook.Sheets("設定").Range("B2").Value, UpdateLinks:=False)
For i = 1 To TargetBook.Worksheets.Count
TargetBook.Worksheets(i).Visible = xlSheetVisible
Next i
'ブックリンク情報の取得
myLinkSources = TargetBook.LinkSources
Set Fso = CreateObject("Scripting.FileSystemObject")
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myLinkSources)
If Not myDic.Exists(Fso.GetFileName(myLinkSources(i))) Then
myDic.Add Fso.GetFileName(myLinkSources(i)), Fso.GetFileName(myLinkSources(i))
End If
Next i
Set Fso = Nothing
For i = 0 To myDic.Count - 1
TargetFileName = myDic.Items()(i)
Call SearchCells
Call SearchNames
Call SearchValidation
Call SearchFormatConditions
Call SearchShapes
Next i
ThisWorkbook.Activate
OutputSheet.Activate
Application.Goto Reference:=OutputSheet.Range("A1"), Scroll:=True
Application.ScreenUpdating = True
MsgBox "外部のブックリンク検索が完了しました。"
End Sub
Private Sub SearchCells()
Dim FindRange As Range
Dim mySheet As Worksheet
Dim StartFindRange As Range
For Each mySheet In TargetBook.Worksheets
If mySheet.FilterMode Then ActiveSheet.ShowAllData
mySheet.Cells.EntireRow.Hidden = False
mySheet.Cells.EntireColumn.Hidden = False
Set FindRange = mySheet.Cells.Find(TargetFileName, LookIn:=xlFormulas, Lookat:=xlPart)
If Not FindRange Is Nothing Then
Set StartFindRange = FindRange
If FindRange.HasFormula = True And InStr(FindRange.Formula, "[") > 0 Then
Call OutputProcess(mySheet.Name, "セル", FindRange.Address, "'" & FindRange.Formula)
End If
'次の検索
Do
Set FindRange = mySheet.Cells.FindNext(FindRange)
'最初に見つかったセルに戻ったら終了
If StartFindRange.Address = FindRange.Address Then Exit Do
If FindRange.HasFormula And InStr(FindRange.Formula, "[") > 0 Then
Call OutputProcess(mySheet.Name, "セル", FindRange.Address, "'" & FindRange.Formula)
End If
Loop
End If
Next mySheet
End Sub
Private Sub SearchNames()
Dim TargetRow As Long
Dim MyName As Name
Dim i As Long
For i = 1 To TargetBook.Names.Count
TargetBook.Names.Item(i).Visible = True
Next i
For Each MyName In TargetBook.Names
If MyName.Value Like "*" & TargetFileName & "*" Then
Call OutputProcess("―", "名前定義", MyName.Name, "'" & MyName.Value)
End If
Next MyName
End Sub
Private Sub SearchValidation()
Dim mySheet As Worksheet
Dim myRange As Range
Dim mySameRange As Range
Dim myValidation As Validation
Dim iCount As Long
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each mySheet In TargetBook.Worksheets
iCount = 0
'エラーの場合（＝入力規則が存在しない） 値は0のままで次へ
iCount = mySheet.Cells.SpecialCells(xlCellTypeAllValidation).Count
If iCount <> 0 Then
'対象セルごと
For Each myRange In mySheet.Cells.SpecialCells(xlCellTypeAllValidation)
'同じ入力規則が設定されているセルをまとめる
Set mySameRange = myRange.SpecialCells(xlCellTypeSameValidation)
If Not myDic.Exists(mySameRange.Address) Then
myDic.Add mySameRange.Address, mySameRange.Address
Set myValidation = mySameRange.Cells(1).Validation
If myValidation.Formula1 Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "入力規則", mySameRange.Address, "'" & myValidation.Formula1)
ElseIf myValidation.Operator = xlBetween Or myValidation.Operator = xlNotBetween Then
If myValidation.Formula2 Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "入力規則", mySameRange.Address, "'" & myValidation.Formula2)
End If
End If
End If
Next myRange
End If
Next mySheet
On Error GoTo 0
End Sub
Private Sub SearchFormatConditions()
Dim mySheet As Worksheet
Dim myFormatCondition As Object
Dim TargetObj As Object
For Each mySheet In TargetBook.Worksheets
For Each myFormatCondition In mySheet.Cells.FormatConditions
Select Case myFormatCondition.Type
Case xlCellValue, xlTextString, xlExpression
If myFormatCondition.Formula1 Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & myFormatCondition.Formula1)
ElseIf myFormatCondition.Type = xlCellValue Then
If myFormatCondition.Operator = xlBetween Or myFormatCondition.Operator = xlNotBetween Then
If myFormatCondition.Formula2 Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & myFormatCondition.Formula2)
End If
End If
End If
Case xlColorScale
For Each TargetObj In myFormatCondition.ColorScaleCriteria
If TargetObj.Value Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & TargetObj.Value)
Exit For
End If
Next TargetObj
Case xlIconSets
For Each TargetObj In myFormatCondition.IconCriteria
If TargetObj.Value Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & TargetObj.Value)
Exit For
End If
Next TargetObj
Case xlDatabar
If myFormatCondition.MaxPoint.Value Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & myFormatCondition.MaxPoint.Value)
ElseIf myFormatCondition.MinPoint.Value Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "条件付き書式", myFormatCondition.AppliesTo.Address, "'" & myFormatCondition.MaxPoint.Value)
End If
End Select
Next myFormatCondition
Next mySheet
End Sub
Private Sub SearchShapes()
Dim mySheet As Worksheet
Dim myShape As Shape
Dim TargetRow As Long
For Each mySheet In TargetBook.Worksheets
For Each myShape In mySheet.Shapes
If myShape.Visible = msoFalse Then myShape.Visible = msoCTrue
Call SerchShapeProcess(mySheet, myShape)
Next myShape
Next mySheet
'チェック用シートを作成している場合、削除
If Not ChackSheet Is Nothing Then
Application.DisplayAlerts = False
ChackSheet.Delete
Application.DisplayAlerts = True
End If
End Sub
Private Sub SerchShapeProcess(mySheet As Worksheet, myShape As Shape)
Dim myShapeTypeName As String
Dim myGroupShape As Shape
Dim TargetAxis As Object
Dim AxisName As String
Dim mySeries As Series
Dim ChackFormulaString As String
Dim ChackOnActionString As String
myShapeTypeName = "図形"
Select Case myShape.Type
Case msoGroup
For Each myGroupShape In myShape.GroupItems
If myGroupShape.Visible = msoFalse Then myGroupShape.Visible = msoCTrue
Call SerchShapeProcess(mySheet, myGroupShape)
Next myGroupShape
Case msoChart
myShapeTypeName = "グラフ"
If myShape.Chart.HasTitle Then
If myShape.Chart.ChartTitle.Formula Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "グラフタイトル", myShape.Name, "'" & myShape.Chart.ChartTitle.Formula)
End If
End If
For Each TargetAxis In myShape.Chart.Axes
If TargetAxis.HasTitle Then
If TargetAxis.AxisTitle.Formula Like "*" & TargetFileName & "*" Then
Select Case TargetAxis.Type
Case xlValue
AxisName = "グラフ数値軸タイトル"
Case xlCategory
AxisName = "グラフ項目軸タイトル"
Case Else
AxisName = "グラフ軸タイトル"
End Select
Call OutputProcess(mySheet.Name, AxisName, myShape.Name, "'" & TargetAxis.AxisTitle.Formula)
End If
End If
Next TargetAxis
For Each mySeries In myShape.Chart.FullSeriesCollection
If mySeries.Formula Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "グラフ系列範囲 / " & mySeries.Name, myShape.Name, "'" & mySeries.Formula)
End If
Next mySeries
Case msoFormControl
'入力規則のドロップダウンの確認
If myShape.FormControlType = xlDropDown Then
If Not DropDownChack(mySheet, myShape) Then Exit Sub
End If
myShapeTypeName = "フォームコントロール"
Select Case myShape.FormControlType
Case xlLabel, xlGroupBox
If ChackSheet Is Nothing Then Set ChackSheet = TargetBook.Sheets.Add
myShape.Copy
Application.Wait Now() + TimeSerial(0, 0, 1)
ChackSheet.Paste
If ChackSheet.DrawingObjects.LinkedCell Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "フォームコントロール / セル参照", myShape.Name, "'" & ChackSheet.DrawingObjects.LinkedCell)
End If
ChackSheet.Shapes(1).Delete
Case Is <> xlButtonControl
If myShape.DrawingObject.LinkedCell Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "フォームコントロール / リンクするセル", myShape.Name, "'" & myShape.DrawingObject.LinkedCell)
End If
If myShape.FormControlType = xlListBox Or myShape.FormControlType = xlDropDown Then
If myShape.DrawingObject.ListFillRange Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, "フォームコントロール / 入力範囲", myShape.Name, "'" & "'" & myShape.DrawingObject.ListFillRange)
End If
End If
End Select
End Select
If myShape.Type <> msoGroup Then
On Error Resume Next
'Formulaプロパティがない場合、エラーで空白のまま次へ
ChackFormulaString = myShape.DrawingObject.Formula
If ChackFormulaString <> "" Then
If myShape.DrawingObject.Formula Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, myShapeTypeName & " / セル参照", myShape.Name, "'" & "'" & myShape.DrawingObject.Formula)
End If
End If
'OnActionプロパティがない場合、エラーで空白のまま次へ
ChackOnActionString = myShape.OnAction
If ChackOnActionString <> "" Then
If myShape.OnAction Like "*" & TargetFileName & "*" Then
Call OutputProcess(mySheet.Name, myShapeTypeName & " / マクロ登録", myShape.Name, "'" & "'" & myShape.OnAction)
End If
End If
End If
On Error GoTo 0
End Sub
'入力規則のドロップダウン除外用
Private Function DropDownChack(mySheet As Worksheet, myShape As Shape) As Boolean
Dim myDropDown As DropDown
DropDownChack = False
For Each myDropDown In mySheet.DropDowns
If myDropDown.Name = myShape.Name Then DropDownChack = True: Exit For
Next myDropDown
End Function
Private Sub OutputProcess(FindSheetName As String, FindTypeName As String, FindPlaceName As String, FindDetail As String)
Dim TargetRow As Long
TargetRow = OutputSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1).Row
OutputSheet.Cells(TargetRow, "A").Value = TargetFileName
OutputSheet.Cells(TargetRow, "B").Value = FindSheetName
OutputSheet.Cells(TargetRow, "C").Value = FindTypeName
OutputSheet.Cells(TargetRow, "D").Value = FindPlaceName
OutputSheet.Cells(TargetRow, "E").Value = FindDetail
End Sub
サンプルファイル保存先：