エクセルで幽霊リンク？探しのVBA

エクセルで幽霊リンク？を探してます。
BOOKを開く際に、「リンクを更新しますか？」とは聞かれませんが、メニューの編集、「リンクの設定」には表示されます。
、「リンクを更新しますか？」と聞いてこないので、セルの数式が他BOOKを参照してるのではないと思いますが、一応、セル内の数式も\マークを検索してチェック済みです。
「名前の定義」も下記のコードでチェックしました。

Sub Names_Check()
Set Sh = ActiveWorkbook.Worksheets.Add
For Each na In ActiveWorkbook.Names
i = i + 1
Sh.Cells(i, 1) = na.Name
Sh.Cells(i, 2) = Mid(na.RefersTo, 2)
Next
End Sub

残されたのは貼り付けた図形やボタン等のオブジェクトが他BOOKのセルを参照しているか、リンク先に他BOOKのセルを指定しているか、他BOOKのマクロを設定してあるかだと思います。しかし、オブジェクトのリンクを取得するコードがわかりません。
ご教示くださいますようお願いいたします。

No.4 ベストアンサー 回答者： KenKen_SP 回答日時： 2007/03/21 08:54

> マクロを設定してあるDrawingObjectsを調べたい

勘違いしてるかもしれませんが....こういうことでしょうか？

　　Dim obj　　 As Object
　　Dim sAction As String
　　
　　On Error Resume Next
　　For Each obj In ActiveSheet.DrawingObjects
　　　　sAction = ""
　　　　sAction = obj.OnAction
　　　　If Len(sAction) > 0 Then
　　　　　 Debug.Print "Obj Name:=" & obj.Name;
　　　　　 Debug.Print "　Action:=" & sAction
　　　　End If
　　Next

この回答へのお礼

ありがとうございます！出来ました！
以下のようにやってみました。

Sub Link_check() 'オブジェクトのリンク一覧

Dim sh As Worksheet, st As Worksheet
Dim sp As Object
Dim i As Long

Set sh = ActiveWorkbook.Worksheets.Add

For Each st In ActiveWorkbook.Sheets
st.Activate

For Each sp In ActiveSheet.DrawingObjects

i = i + 1

On Error Resume Next

sh.Cells(i, 1) = sp.Name
sh.Cells(i, 2) = sp.Formula
sh.Cells(i, 3) = st.Name & "-" & sp.TopLeftCell.Address
sh.Cells(i, 4) = sp.Width
sh.Cells(i, 5) = sp.Height
sh.Cells(i, 6) = sp.LinkedCell

If Len(sp.OnAction) > 0 Then
sh.Cells(i, 7) = "　Action:=" & sp.OnAction
End If

On Error GoTo 0

Next sp
Next st

End Sub

お礼日時：2007/03/21 10:29

No.5 回答者： Wendy02 回答日時： 2007/03/21 11:55

こんにちは。

以前、幽霊リンクの削除のマクロは作ったことがありますが、今回の問題は、私の経験してきたものは違うし、状況をいまだに把握していません。オートシェイプなどOnAction で、別のブックにリンクして、リンクがなければ、エラーが出ます。しかし、マクロで、OnAction は取れます。しかし、コントロールツールは、別のブックのマクロにつけるということは、Call しなければ、基本的にありませんし、また、コピーすれば、そのまま、親オブジェクトがすげ替わるはずです。

Excel2000 で、編集－リンクの設定　で出てくる問題は、主に二つあって、ひとつは非表示のオートシェイプと、もう一つは失われたブックへのリンクで、Excel2000では、修正できないのでトラブルとして扱われています。

Excel2000 で、該当しないリンクが出てくる場合は、通常の方法では消せないものがあったと思います。

以下のようなものに該当するのではありませんか？

http://support.microsoft.com/default.aspx?scid=k …
[XL2000]ブック間のリンクを変更する方法および解除する方法

http://hp.vector.co.jp/authors/VA016119/kitan01. …
幽霊リンクバスターズ　(芳坂氏のサイト）

この回答へのお礼

何度もありがとうございます。
下記#5のコードで確認の結果、予想通りオブジェクトに設定された他BOOKのマクロを発見しました。
これを削除したところ、編集－「リンクの設定」は消滅しました。

お手数をおかけしました。

お礼日時：2007/03/21 17:11

No.3 回答者： Wendy02 回答日時： 2007/03/21 02:17

こんばんは。

>オブジェクトのマクロを設定するのはOnActionですが、これでは取得できないようです。

どうやら、目的が違うようですね。もともと、幽霊リンクを探す目的ではなかったのでしょうか？フォームツールやコントロールツールのコマンドボタン(OLEObject)は、通常、外部から呼び出すということはないと思うのですが……。

オートシェイプには、OnAction は取れますね。

「幽霊リンク」というのは、オブジェクトなどで不明な外部リンク先のことですが、すべてのオブジェクトのリンク先やマクロ名自体を出す話になると、ちょっと、それは、今の私には出来そうにもありませんね。私の経験があるのは、あくまでも、埋め込み型のリンクで、トラブルが生じている時のみです。

この回答へのお礼

> どうやら、目的が違うようですね。もともと、幽霊リンクを探す目的ではなかったのでしょうか？

いいえ、違わないんです。
#2のお礼にも書いたとおり、他BOOKからコピーしてきたシート内に他BOOKのマクロを設定したオブジェクトがあるのではないかと見当をつけたのです。（この場合、BOOKを開く際に、「リンクを更新しますか？」とは聞かれませんが、メニューの「編集」、「リンクの設定」には表示されます。）

お礼日時：2007/03/21 10:07

No.2 回答者： KenKen_SP 回答日時： 2007/03/20 13:31

こんにちは。

お久しぶりです。

> オブジェクトのリンクを取得するコードがわかりません。

オブジェクトが Oval とか TextBox などのことなら、こんな感じでは？

　　Dim obj As Object
　　
　　On Error Resume Next
　　For Each obj In ActiveSheet.DrawingObjects
　　　　Debug.Print obj.Formula
　　Next

グループ化されている図形等は、解除しないとダメかもしれません。
他に考えられるのは...

　　・入力規則のリストで参照がある
　　・グラフの要素で参照がある

ぐらいが思いつきました。

どれもこれも確認はしてませんので、ご参考までで。

この回答へのお礼

KenKen_SPさま、ありがとうございます。

入力規則は設定していませんし、グラフもありません。
多分、他ブックのマクロを設定したままになっているんだと思うんです。
というか、他BOOKからシートのコピーでもってきてしまっていると思うんです。

ですからマクロを設定してあるDrawingObjectsを調べたいのですが、DrawingObjectsにマクロがあるかないかの判別方法がわかりません。
よろしくお願いします。

お礼日時：2007/03/20 18:53

No.1 回答者： Wendy02 回答日時： 2007/03/20 13:26

こんにちは。

私は、マクロも作ったことはありますが、マクロではどうにもならないものもあるし、逆に、マクロでないと無理なものもあります。それは一括でということは出来ません。

それと、Excel2000独特の問題もあったような記憶があります。

もっとも原因が高いのが、非表示の図形の中にある数式。
リンク先のなくなったもの。
「名前」は、マクロでは引っかからないものもあります。

それと、Windows フォルダのどこかのTempフォルダに残骸が残っているときも問題になることがあります。

オートシェイプの図形描画の場合：

Sub SearchFomulaShapes()
　　Dim j As Long
　　With ActiveSheet
　　　　'On Error Resume Next
　　　　For j = 1 To .Shapes.Count
　　　　　　With .Shapes(j)
　　　　　　　　If .DrawingObject.Formula <> Empty Then
　　　　　　　　If InStr(.DrawingObject.Formula, ".xls") <> 0 Then
　　　　　　　　　 MsgBox .Name & "にある"
　　　　　　　　End If
　　　　　　　　End If
　　　　　　End With
　　　　Next j
　　　　On Error GoTo 0
　　End With
End Sub

この回答へのお礼

ありがとうございます。
わたしも質問した後、なんとかここまでは作ったのです。
でも、マクロが仕込んであるものの取得はわかりませんでした。

Sub Link_check() 'オブジェクトのリンク一覧
Set Sh = ActiveWorkbook.Worksheets.Add
For Each st In ActiveWorkbook.Sheets
st.Activate
For Each sp In ActiveSheet.DrawingObjects
i = i + 1
On Error Resume Next
Sh.Cells(i, 1) = sp.Name
Sh.Cells(i, 2) = sp.Formula
Sh.Cells(i, 3) = st.Name
Sh.Cells(i, 4) = sp.Width
Sh.Cells(i, 5) = sp.Height
Sh.Cells(i, 6) = sp.LinkedCell
Next sp
Next st
End Sub

オブジェクトのマクロを設定するのはOnActionですが、これでは取得できないようです。

お礼日時：2007/03/20 13:35