|
こちらは Excel2000 を使ってますが、以下のコードでうまくいくようです。
Sub Test_Hplk()
Dim Pic As Object
Dim AdSt As String
If ActiveSheet.Pictures.Count = 0 Then
MsgBox "画像が挿入されていません", 48
Exit Sub
End If
For Each Pic In ActiveSheet.Pictures
On Error Resume Next
AdSt = Pic.ShapeRange.Item(1).Hyperlink.Address
If AdSt <> "" Then Debug.Print Pic.TopLeftCell _
.Address(0, 0) & " : " & AdSt
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0
Next
If AdSt <> "" Then
With Application.VBE.MainWindow
.Visible = True
.SetFocus
End With
SendKeys "^(g)", True
Else
MsgBox "ハイパーリンクのアドレスがありません", 48
End If
End Sub
|
|