ExecuteExcel4Macroについて

質問

エクセルで、フォームで挿入した「ラベル」に他シートのセルを参照させてマクロの記録をとると以下のようになります。
Sub Macro1()
ActiveSheet.Labels.Add(526.5, 301.5, 76.5, 18).Select
ExecuteExcel4Macro "FORMULA(""=FACE!R[7]C[10]"")"
End Sub

では、逆にラベルに設定された参照元を取得するにはどう記述すればようでしょうか？

For Each sp In ActiveSheet.DrawingObjects
i = i + 1
On Error Resume Next
sh.Cells(i, 2) = TypeName(sp)
sh.Cells(i, 3) = sp.Name
sh.Cells(i, 4) = sp.Formula
next
では、取得出来ませんでした。

回答No.2

Wendy02 · ベストアンサー

こんにちは。

このようにすればよいです。オブジェクトの名前が必要なのです。
ただし、以下は、実態には、Application.ScreenUpDating =False を入れたほうがよいです。

Sub test02()
Dim sp As Object
Dim i As Integer
Dim obj_n As String 'オブジェクトの名前
　　With ActiveSheet
　　　　For Each sp In .DrawingObjects
　　　　　　i = i + 1
　　　　　　.Cells(i, 1) = TypeName(sp)
　　　　　　.Cells(i, 2) = sp.Name: obj_n = sp.Name
　　　　　　.Cells(i, 3) = sp.TopLeftCell.Address
　　　　　　On Error Resume Next
　　　　　　.Cells(i, 4) = sp.Formula
　　　　'GET.OBJECT で、リンクがないものを取ると、False になる
　　　　　　.Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)")
　　　　　　On Error GoTo 0
　　　　Next
　　End With
End Sub

お礼

重ね重ね、有難うございました！
無事、目的を果たすことが出来ました。
これで安心して明日会社に行けます。

回答No.1

Wendy02

こんにちは。

以下のように配列にする必要性はないのですが、最近、また、プログラムの勉強をしていたら、配列のことが出てきましたので、使わせていただきました。わざわざ、変数を置いたら二重になるので、そのまま配列に入れてしまいました。

Sub GetInfoObject()
　　Dim i As Integer
　　Dim sh As Worksheet
　　Dim sp As Object
　　Dim ar(0, 2) As Variant
　　Set sh = ActiveSheet
　　For Each sp In ActiveSheet.DrawingObjects
　　　　i = i + 1
　　　　On Error Resume Next
　　　　ar(0, 0) = TypeName(sp)
　　　　ar(0, 1) = sp.Name
　　　　ar(0, 2) = ExecuteExcel4Macro("Get.Object(48,""" & ar(0, 1) & """)")
　　　　If VarType(ar(0, 2)) = vbBoolean Then ar(0, 2) = ""
　　　　sh.Cells(i, 2).Resize(, 3).Value = ar()
　　　　Erase ar()
　　Next
End Sub

お礼

さっそく有難うございました。
Wendy02様のコードをコピペしましたら取得することが出来ました。
ただ、勝手を言って申し訳ないのですが、私の不勉強で配列がまだよく理解できていませんので応用がききません。

配列を使わないで取得するにはどう変えればよろしいのでしょうか？

Sub test01()
With ActiveSheet
For Each sp In .DrawingObjects
i = i + 1
.Cells(i, 1) = TypeName(sp)
.Cells(i, 2) = sp.Name
.Cells(i, 3) = sp.TopLeftCell.Address
On Error Resume Next
.Cells(i, 4) = sp.Formula
.Cells(i, 5) = ExecuteExcel4Macro("Get.Object(48)")
On Error GoTo 0
Next
End With
End Sub

とやってみましたが、ダメでした。
TextBoxやオートシェープのRectangleなら　= sp.Formula　で簡単に取得できるものが、Labelだとどうしてダメなのかも分かりませんが、配列もよく分かってないのです・・・。

補足

現在、Labelの参照元を調べられずにいるコードのオリジナルは以下の通りです。

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

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

Set sh = ActiveWorkbook.Worksheets.Add

i = 1

sh.Cells(i, 1) = "SheetName"
sh.Cells(i, 2) = "TypeName"
sh.Cells(i, 3) = "Name"
sh.Cells(i, 4) = "Formula"
sh.Cells(i, 5) = "TopLeftCell"
sh.Cells(i, 6) = "Width"
sh.Cells(i, 7) = "Height"
sh.Cells(i, 8) = "LinkedCell"
sh.Cells(i, 9) = "OnAction"
sh.Cells(i, 10) = "Font"
sh.Cells(i, 11) = "Visible"

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) = st.Name
sh.Cells(i, 2) = TypeName(sp)
sh.Cells(i, 3) = sp.Name
sh.Cells(i, 4) = sp.Formula
sh.Cells(i, 5) = sp.TopLeftCell.Address
sh.Cells(i, 6) = sp.Width
sh.Cells(i, 7) = sp.Height
sh.Cells(i, 8) = sp.LinkedCell
If Len(sp.OnAction) > 0 Then
sh.Cells(i, 9) = "Action:=" & sp.OnAction
End If
sh.Cells(i, 10) = sp.Font.Name
sh.Cells(i, 11) = sp.Visible

On Error GoTo 0

Next sp
Next st

End Sub