Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7007 / 13644 ツリー ←次へ | 前へ→

【41797】画像につけられたリンクを取得したいので... koma 06/8/23(水) 9:21 質問[未読]
【41799】Re:画像につけられたリンクを取得したいの... koma 06/8/23(水) 10:03 発言[未読]
【41800】Re:画像につけられたリンクを取得したいの... Blue 06/8/23(水) 10:06 回答[未読]
【41802】Re:画像につけられたリンクを取得したいの... Blue 06/8/23(水) 10:26 回答[未読]
【41815】Re:画像につけられたリンクを取得したいの... koma 06/8/23(水) 16:34 発言[未読]
【41816】Re:画像につけられたリンクを取得したいの... Blue 06/8/23(水) 16:52 発言[未読]
【41818】Re:画像につけられたリンクを取得したいの... Kein 06/8/23(水) 18:01 回答[未読]
【41819】Re:画像につけられたリンクを取得したいの... koma 06/8/23(水) 18:31 お礼[未読]

【41797】画像につけられたリンクを取得したいので...
質問  koma  - 06/8/23(水) 9:21 -

引用なし
パスワード
   初めまして。VBA初心者のkomaです。

-状況は-
エクセルのシートにいくつか画像があり、それをクリックすると、リンク先の
URLに飛ぶ、という状態です。但し、画像は無作為に置かれており、
セルに対応しているわけでもありません。

-やりたいのは-
それぞれのリンク先のURLを取得したい

ということなのですが、どのようにすれば取得できるでしょうか?
セルに文字列があって、そのリンク先を取得する、というのはどこかで
見つけたのですが、画像だとセルを指定できないので、どうして良いのか
分かりません。

どうぞ宜しく御願いします。

【41799】Re:画像につけられたリンクを取得したい...
発言  koma  - 06/8/23(水) 10:03 -

引用なし
パスワード
   komaです。

補足です

現状では画像のリンク先は、
「画像を右クリック」→「ハイパーリンクの編集」→「アドレス」
で見ることが可能ではあります。

宜しく御願いします!

【41800】Re:画像につけられたリンクを取得したい...
回答  Blue  - 06/8/23(水) 10:06 -

引用なし
パスワード
   あるシート上のすべてのPictureであれば、

  Dim o As Object
  
  For Each o In ActiveSheet.DrawingObjects
    If TypeOf o Is Picture Then
      Debug.Print o.ShapeRange.Item(1).Hyperlink.SubAddress
    End If
  Next

のように取得できると思います。

【41802】Re:画像につけられたリンクを取得したい...
回答  Blue  - 06/8/23(水) 10:26 -

引用なし
パスワード
   別解)

Hyperlinksから、Pictureに割り付けられたものを探す方法です。

  Dim h As Hyperlink
  For Each h In ActiveSheet.Hyperlinks
    If TypeOf h.Parent Is Shape Then
      If h.Parent.Type = msoPicture Then
        Debug.Print h.SubAddress
      End If
    End If
  Next

【41815】Re:画像につけられたリンクを取得したい...
発言  koma  - 06/8/23(水) 16:34 -

引用なし
パスワード
   ▼Blue さん:

komaです。

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

しかし先に回答して頂いた方では
   Debug.Print o.ShapeRange.Item(1).Hyperlink.SubAddress
のところで、「実行時エラー'1004' アプリケーション定義または
オブジェクト定義のエラーです」とのメッセージ。

もう一つの別解ではエラーはないものの、イミディエイトウィンドウを
見てもURLは表示されず、リンクの数だけ改行されているようです、、、

私の環境が、動かないような環境なのでしょうか、、OSはXPで、エクセルは2002
です。画像も http://news.google.co.jp/nwshp?ned=jp の左上にある
Googleなんかからシートにコピーしてきたものなのですが。

どうぞ宜しく御願いします!

【41816】Re:画像につけられたリンクを取得したい...
発言  Blue  - 06/8/23(水) 16:52 -

引用なし
パスワード
    ▼koma さん:
>しかし先に回答して頂いた方では
>   Debug.Print o.ShapeRange.Item(1).Hyperlink.SubAddress
>のところで、「実行時エラー'1004' アプリケーション定義または
>オブジェクト定義のエラーです」とのメッセージ。
これは、ハイパーリンクがついていないPictureがあればそうなります。
On Error Resume Next 等をつかって回避してください。

>私の環境が、動かないような環境なのでしょうか、、OSはXPで、エクセルは2002
>です。
私の環境は Windows XP Pro SP2/Office 2003 SP2 です。
環境はあまり関係ないような気もします。
よろしければ、まっさらのBookからつくっても再現可能になるような手順を教えてもらえませんか?

【41818】Re:画像につけられたリンクを取得したい...
回答  Kein  - 06/8/23(水) 18:01 -

引用なし
パスワード
   こちらは 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

【41819】Re:画像につけられたリンクを取得したい...
お礼  koma  - 06/8/23(水) 18:31 -

引用なし
パスワード
   ▼Kein さん:

komaです

ありがとうございました! このコードで完全に作動しました!
何と言ってお礼を申し上げればいいのか分かりませんが、
ありがとうございました!

7007 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free