[[20210219145610]]　『Excel　VBA　貼付け画像リンク切れ』（KAZU）　ページの最後に飛ぶ

『Excel　VBA　貼付け画像リンク切れ』（KAZU）

教えてください。
過去に作成したマクロが上手く動きません。

具体的には画像がリンク切れになり、見れなくなります。

素人なのでどこを修正するべきか分からないので、ご教授ください。
よろしくお願いします。

Sub 画像挿入()

    Dim i As Integer     '「i」は「行」に相当
    Dim j As Integer
    Dim myDir As String
    Dim myFName As String

    myDir = Application.GetOpenFilename(filefilter:="すべての図(*.JPG),*.JPG")
    If myDir = "false" Then Exit Sub
    myDir = Left(myDir, Len(myDir) - Len(Dir(myDir)))

    Application.ScreenUpdating = False
    ActiveSheet.DrawingObjects.Delete

    i = 8     '画像挿入開始行の指定
    j = 1
    myFName = Dir(myDir & "*.JPG")

    Do While myFName <> ""
        With Cells(i, 2)      '画像挿入列の指定　Cells(行,列)
            .Activate
        End With
        With ActiveSheet
            .Pictures.Insert myDir & myFName
            With .Shapes(j)
                .LockAspectRatio = msoTrue     '画像の縦横比固定
                .Width = 300     '画像の幅を指定
            End With
        End With
        Cells(i, 3).Value = myFName      '画像名称挿入列の指定
        myFName = Dir

        i = i + 17     '２枚目の画像挿入位置指定
        j = j + 1

        With Cells(i, 2)     '↓２枚目の画像挿入
            .Activate
        End With
        With ActiveSheet
            .Pictures.Insert myDir & myFName
            With .Shapes(j)
                .LockAspectRatio = msoTrue
                .Width = 300
            End With
        End With
        Cells(i, 3).Value = myFName
        myFName = Dir

        i = i + 17
        j = j + 1

        With Cells(i, 2)     '↓３枚目の画像挿入
            .Activate
        End With
        With ActiveSheet
            .Pictures.Insert myDir & myFName
            With .Shapes(j)
                .LockAspectRatio = msoTrue
                .Width = 300
            End With
        End With
        Cells(i, 3).Value = myFName
        myFName = Dir

        i = i + 25     '次のページへ
        j = j + 1

    Loop     'Do While ～ に戻り繰り返し

    Application.ScreenUpdating = True

End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンクオブジェクトとして挿入される
(https://support.microsoft.com/ja-jp/topic/excel-2010-で-pictures-insert-メソッドを使用して図をワークシートに挿入すると図がリンク-オブジェクトとして挿入される-c8f364ea-bcc1-1397-5df7-a1b4c5fbab78)

おそらくこれではないかと思いますがいかがでしょうか。
（半可通） 2021/02/19(金) 16:10

回答ありがとうございます。

おそらくご指摘の内容が原因だと思います。

正常化する手段（コード修正）を教えて頂けると助かります。
（KAZU） 2021/02/19(金) 16:22

リンク先にもあるように
.Pictures.Insert
から
.Shapes.AddShape
に変更してください。
引数が省略できない点等に留意すればさほど難しくないと思いますがいかがでしょうか。
（半可通） 2021/02/19(金) 16:43

AddShapeではなくAddPictureでしたね。すみませんでした。
（半可通） 2021/02/19(金) 17:34

親切に教えて頂きありがとうございます。

AddPictureの引数について、色々調べましたが
素人ではなかなか上手く扱えません。

With ActiveSheet

            .Pictures.Insert myDir & myFName
            With .Shapes(j)
                .LockAspectRatio = msoTrue
                .Width = 300

上記コードを直接直して頂けないでしょうか？
お手数ですがよろしくお願いします。
（kazu） 2021/02/19(金) 23:06

他の書き込みで見つけました。

Pictures.Insertで張り付けた後に
　Selection.Cut
　ActiveSheet.Pictures.Paste.Select

をする事で解決出来るのではないでしょうか。

しかし無駄があるので、AddPictureがスマートですね。

コード修正が出来る方が居ればお願いします。
（haru） 2021/02/20(土) 09:21

 ＞   .Pictures.Insert myDir & myFName
         ↓
      .Shapes.AddPicture myDir & myFName, msoFalse, msoTrue, 0, 0, -1, -1
（半平太） 2021/02/20(土) 10:16

コメント返信：

[ 一覧(最新更新順) ]

[[20210219145610]] 『Excel VBA 貼付け画像リンク切れ』（KAZU） ページの最後に飛ぶ

[[20210219145610]]　『Excel　VBA　貼付け画像リンク切れ』（KAZU）　ページの最後に飛ぶ