[[20230622124713]] 『一括で画像を挿入する際に画像にハイパーリンクを』(VBA初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『一括で画像を挿入する際に画像にハイパーリンクを付与したい』(VBA初心者)

以下のようなコードを作成し、マクロが保存されているディレクトリ内の画像を一括でセルに挿入するようにしました。この画像をクリックした際に元画像を開くようハイパーリンクを付与したいのですが、その方法が分からず、どのようにコードを記載したら良いかご教授いただけないでしょうか。よろしくお願いいたします。

Sub InsertImages()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim filePath As String
    Dim fileName As String
    Dim img As Picture

    ' 全てのシートに対して処理を実行
    For Each ws In ThisWorkbook.Sheets
        ws.Activate

        ' 最終行を取得
        lastRow = Cells(Rows.Count, "A").End(xlUp).Row

        ' 各行のA列の値に対応するファイルを検索して画像を挿入
        For i = 1 To lastRow
            filePath = ThisWorkbook.Path & "\" & Cells(i, "A").Value & ".jpg" ' ファイルパスを作成
            fileName = Dir(filePath) ' ファイルが存在するかチェック

            If fileName <> "" Then ' ファイルが存在する場合
                Set img = ws.Pictures.Insert(filePath) ' 画像を挿入
                With img
                    .ShapeRange.LockAspectRatio = msoFalse ' アスペクト比を固定解除
                    .Top = Cells(i, "J").Top ' D列のセルの上部に配置
                    .Left = Cells(i, "J").Left ' D列のセルの左側に配置
                    .Width = Cells(i, "J").Width
                    .Height = Cells(i, "J").Height
                    .ShapeRange.Line.Visible = msoTrue
                    .ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)   '色の指定(黒)
                   End With
            End If
        Next i
    Next ws
End Sub

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 試してませんが参考過去ログです。

[[20111110190836]] 『貼り付けられた画像にその画像ファイルをLINKさせ』(はんにゃ)
(とおりすがりんご) 2023/06/22(木) 13:18:41


 ws.Hyperlinks.Add Anchor:=ws.Shapes(i), Address:=filePath
 を追加するとかですか?
(xyz) 2023/06/22(木) 13:32:20

 あ、そうか。シートに既にshapeがある場合に備えて、
 ws.Hyperlinks.Add Anchor:=ws.Shapes(ws.Shapes.Count), Address:=filePath
 としたほうが確実かもしれません。
(xyz) 2023/06/22(木) 13:38:19

(とおりすがりんご)さん
ご紹介いただいた過去リンクを読ませていただきましたが、他の内容も含め情報量が多く私の技量では、解決には至りませんでした。また機会があればよろしくお願いします。
(VBA初心者) 2023/06/22(木) 13:56:14

(xyz)さん
お教えいただいた内容を含め以下のとおりコードを修正いたしましたら実現できました。初歩的な質問で恐縮ですが、Anchor:=ws.Shapes(ws.Shapes.Count)この箇所ではなぜ、既に画像データがある場合でも目的の画像を指定してハイパーリンクを付与できるのでしょうか。ws.Shapes.Countここがいまいち理解できずにおります。
ご教授いただけましたら幸いです。
(VBA初心者) 2023/06/22(木) 13:59:41

 Hyperlinks.AddメソッドのAnchor引数には、「Rangeオブジェクト」または「Shapeオブジェクト」を
 渡す必要があります(Addメソッドのヘルプを確認しました)。

 Shapeオブジェクトは、「入力規則」も「コメント」も含みますので、
 そうしたものや、既存の画像があれば、単純に ws.Shapes(i) とするわけには行きません。
 ずれてきます。

 そこで、作成直後のshapeは、「すべてのshapeの個数」と同じindexを使って参照できると考え、
 ws.Hyperlinks.Add Anchor:=ws.Shapes(ws.Shapes.Count), Address:=filePath
 でいけるだろうと思いました。うまくいきませんか?

 その後、よくよく考えると、
 ・imgというPictureオブジェクトはShapeRangeコレクションプロパティを持ち、
 ・その最初のindexのものがShapeである
 ことが、ローカルウインドウでimgの要素を観察することにより判明しました。

 従って、ファイナルアンサーとして
 ws.Hyperlinks.Add Anchor:=img.ShapeRange(1), Address:=filePath
 とするとよいと思います。
(xyz) 2023/06/22(木) 15:26:06

 なお、一番最初はマクロ記録をとって、その分析から始めました。
 結果だけでなく、解決に向けたアプローチ方法にも注目してもらうとよいでしょう。
(xyz) 2023/06/22(木) 15:27:52

(xyz)さん
非常に丁寧にご説明いただき、誠にありがとうございます。最初にお教えいただいた(ws.Hyperlinks.Add Anchor:=ws.Shapes(ws.Shapes.Count), Address:=filePath)でもやりたかったことは実現できましたが、画像ファイルにのみハイパーリンクを付与したいと目的が明確であるのであれば(ws.Hyperlinks.Add Anchor:=img.ShapeRange(1), Address:=filePath)こちらの方が良いかもしれないことが分かりました。  

普段、マクロの記録には頼らずにという前提で取り組んでいたことが、解決へのアプローチの機会を失っていたことにあらためて気づきました。また、お恥ずかしい話ですが、ローカルウィンドウを使用したこともなかったので、仰るとおりに要素の変遷を確認してみると理解しやすかったです。

このたびは色々とお教えいただき、大変勉強になりました。あらためて感謝申し上げます。
また機会がありましたらどうぞよろしくお願いいたします。
(VBA初心者) 2023/06/22(木) 15:57:15


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.