[[20210222120158]]　『VBA　『画像貼付⇒サイズ変更』をループさせたい』（HARUKA）　ページの最後に飛ぶ

『VBA　『画像貼付⇒サイズ変更』をループさせたい』（HARUKA）

以下のVBAをループさせたいのですが、上手く動きません。
コードを添付するので、どこを直せばよいか教えてください。

＜やりたい事＞
　・フォルダー内の写真を1ページに3枚ずつ貼付け。
　・画像サイズを縦横比固定の高さ215に変更。

＜修正したい事＞
　画像選択を下記にしている為、4枚目からサイズ変更が効かない。
　Set shp = ActiveSheet.Shapes(1)

＜コード＞
　具体的にどこを修正すれば良いか、ご教授ください。
　よろしくお願いします。

Sub 画像挿入()

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

    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
             .Shapes.AddPicture myDir & myFName, msoFalse, msoTrue, Selection.Left, Selection.Top, -1, -1

        Set shp = ActiveSheet.Shapes(1)
         With shp
          .LockAspectRatio = msoTrue
          .Height = 215
        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
             .Shapes.AddPicture myDir & myFName, msoFalse, msoTrue, Selection.Left, Selection.Top, -1, -1

        Set shp = ActiveSheet.Shapes(2)
         With shp
          .LockAspectRatio = msoTrue
          .Height = 215
        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
             .Shapes.AddPicture myDir & myFName, msoFalse, msoTrue, Selection.Left, Selection.Top, -1, -1

        Set shp = ActiveSheet.Shapes(3)
         With shp
          .LockAspectRatio = msoTrue
          .Height = 215
        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 ＞

その変数jは何をしているのですか
（かんぴょう） 2021/02/22(月) 12:47

かんぴょうさん

すいません。
無知なまま色々な書込みを参考に作成したので、無駄が
含まれているかも知れません。

勉強中なので、上記の質問以外でも気になる点があれば
ご教授ください。

よろしくお願いします。
（HARUKA） 2021/02/22(月) 12:56

ではまず
ステップ実行
と
ローカルウィンドウ
から覚えましょう。
詳しくは検索してください。
（かんぴょう） 2021/02/22(月) 12:59

かんぴょうさん
　検索しながら勉強します。

どなたか、上記質問に対してご解答を頂ければと思います。

素人質問ですいませんが、直接コード修正して教えて頂けると助かります。

（HARUKA） 2021/02/22(月) 14:02

では
ローカルウィンドウを見ながらステップ実行していき
Set shp = ActiveSheet.Shapes(1)
Set shp = ActiveSheet.Shapes(2)
Set shp = ActiveSheet.Shapes(3)
の行に来たとき、jの値はそれぞれどうなっていますか？
（かんぴょう） 2021/02/22(月) 14:28

かんぴょうさん

頂いたアドバイスを基に考えてみましたが・・・

答えが見えません。

解決策があれば、教えて頂きたいです。
（HARUKA） 2021/02/22(月) 15:16

 >頂いたアドバイスを基に考えてみましたが・・

どんな風に考えたのでしょうか？
口先だけなら、考えたけど解りませんですみます。
（考える人） 2021/02/22(月) 15:29

考えなくても良いので14:28の内容を実践してください。
考えるのはそれからで良いてす。
（かんぴょう） 2021/02/22(月) 15:40

コメント返信：

[ 一覧(最新更新順) ]

[[20210222120158]] 『VBA 『画像貼付⇒サイズ変更』をループさせたい』（HARUKA） ページの最後に飛ぶ

[[20210222120158]]　『VBA　『画像貼付⇒サイズ変更』をループさせたい』（HARUKA）　ページの最後に飛ぶ