Excelのマクロの呼び出し元を知りたい

お世話になります。

以下の問題の探し方を教えてください。

自分で作成したものでない（作成者は社内にいない）
３０前後のシートが入っているエクセルファイルがあります。
そういうファイル（群）を解析しています。

あるマクロのメソッド「商品検索」というものが書かれているとします。
ぱっと見では使われていないような感じもします。
しかし厳密にしたいので、そのメソッドがどこで（どのシート、どのボタン等）呼ばれているか、
を調べたいのですが、うまい方法はありませんでしょうか。

このエクセルファイル群は、初めに使えそうなエクセルファイルから
始まり、様々な方がその基本となったエクセルを元にして、
いろいろ修正、追加、削除しながら分派、育っていったファイルらしく、
数年の経てそれぞれ目的が違うファイルに仕上がってます。
その数が数だけにモジュールの中にあるメソッドが「使われているか」を手早く知りたいのです。
ですので、一つ一つ右クリックで調べる以外の方法を探しています。

手段でもツールの使用でもかまいません。
どなたか教えていただけませんでしょうか。

No.1 ベストアンサー 回答者： merlionXX 回答日時： 2008/07/08 17:56

こういうのはどうでしょうか？

各シートに配置されたボタン等のオブジェクトを検索し、それにマクロが登録されていればシート名、オブジェクト名およびマクロ名を新しいワークシート（一番右端に生成します）にリストアップするマクロです。(マクロが登録されていないオブジェクトはリストに入れません。)

Sub test01()
Set ns = Sheets.Add(After:=Sheets(Sheets.Count))
For Each st In Worksheets
st.Activate
For Each obj In ActiveSheet.DrawingObjects
If obj.OnAction <> "" Then
i = i + 1
With ns
.Cells(i, "A") = ActiveSheet.Name
.Cells(i, "B") = obj.Name
.Cells(i, "C") = obj.OnAction
End With
End If
Next
Next
Set ns = Nothing
End Sub

この回答へのお礼

merlionXXさんありがとうございます。
早速試してみました。

すばらしいです。
私がほしい情報そのものです。

ありがとうございました。
使わせていただきます。

お礼日時：2008/07/09 09:27

No.3 回答者： kenpon24 回答日時： 2008/07/08 18:07

うっはNo1さんともろかぶりな内容。

しかもコード短くて結果も集計しやすいかも。

No1さんのを使ってやってください。

この回答へのお礼

kenpon24さん、ありがとうございます。
merlionXXさんもですが、なるほどそうですね、というもので
わかりやすくて、これを参考・基本にして他もできそうです。

全シート、全セルでオブジェクトを引っ掛けて中身を取るんですね。
本当に「なるほど・・・」という気持ちでいっぱいです。

ありがとうございました。

お礼日時：2008/07/09 09:36

No.2 回答者： kenpon24 回答日時： 2008/07/08 18:00

シート内のオブジェクトから呼び出しているものを知りたいという前提で書きます。

全シートのオブジェクトに登録されているマクロを集計シートに書き出すマクロを書いてみました。
集計するにはあまりよくない書き出し方かも。

Sub 全シートのマクロ書き出し()
Dim shape As Object
Dim ws As Worksheet
Dim i As Long

Const temp As String = "呼び出し元集計"
i = 1

On Error GoTo SheetNothing
with Worksheets(temp)
.Activate
.Cells.ClearContents '初期化。もしtempと同じ名前のシートがある場合は注意
end with

'全シート調査
For Each ws In ActiveWorkbook.Worksheets
Worksheets(temp).Cells(i, 1) = ws.Name 'シート名書き出し
i = i + 1

'全図形調査
For Each shape In ws.Shapes
'マクロが登録されているとき
If shape.OnAction <> "" Then
'マクロ名を書き出す
Worksheets(temp).Cells(i, 1) = shape.OnAction
i = i + 1
End If
Next
i = i + 1
Next

Worksheets(temp).Activate

Set shape = Nothing
Set ws = Nothing

Exit Sub

SheetNothing:
'シートがないときは作成する
Worksheets.Add
Worksheets(Worksheets.Count).Name = temp
Resume

End Sub