[[20200714115907]]　『VBAで画像貼り付けの位置指定したい』（nai）　ページの最後に飛ぶ

『VBAで画像貼り付けの位置指定したい』（nai）

現在、フォルダ内の画像を1枚目の位置を上から10ポイントに指定、二枚目以降5ポイント間隔で張り付けるコードを書きました。

これを、
1枚目：上からポイント10の位置に貼り付け
2～4枚目：ポイント5間隔で張り付け
5枚目：4枚目からポイント10の位置に貼り付け
6～9枚目：ポイント5間隔で張り付け
・・・
としたいのですがどうすればよいのでしょうか。

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

具体的なところはコードを見ないとわかりませんが
もしループ処理をしているなら
大ループで10ポイント×１
小ループで5ポイント×いくつか
という感じでしょう
（苫） 2020/07/14(火) 12:10

苫様

お返事ありがとうございます。
コードは以下です。

Dim lngTop As Long

 Dim objFile As Object 
 Dim objFldr As FileSystemObject

 Set objFldr = CreateObject("Scripting.FileSystemObject")

 lngTop = 45

 For Each objFile In objFldr.GetFolder(ThisWorkbook.Path &"\picture").Files
 ActiveSheet.Shapes.AddPicture _
 Filename:=objFile, _
 LinkToFile:=False, _
 SaveWithDocument:=True, _
 Left:=11, _
 Top:=lngTop, _
 Width:=200, _
 Height:=150

 lngTop = lngTop + 150 + 16 
 Next

End Sub

（nai） 2020/07/14(火) 12:13

 回答者への参考として。

[[20200713201750]]　『VBA画像貼り付けのループについて』（さく）
（OK） 2020/07/14(火) 12:39

こんな風にするといいと思います。

＞OKさん
ありがとうございます。

    Dim lngTop As Long
    Dim objFile As Object
    Dim objFldr As FileSystemObject
    Set objFldr = CreateObject("Scripting.FileSystemObject")
    lngTop = 45
    For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\picture").Files
        ActiveSheet.Shapes.AddPicture _
         Filename:=objFile, _
         LinkToFile:=False, _
         SaveWithDocument:=True, _
         Left:=11, _
         Top:=lngTop, _
         Width:=200, _
         Height:=150

        'ここに画像間隔を調整するコードを書く
        '（カウンタが3の倍数の時だけアホみたいに値が増えるコード等）

        lngTop = lngTop + 150 + 16  '16の値を調整された値に書き換え
    Next

（苫） 2020/07/14(火) 12:46

 >カウンタが3の倍数の時だけアホみたいに値が増える

 今の若い人はわからないかも？？
（OK） 2020/07/14(火) 12:48

わかってくれる人がいて安心しました。
（苫） 2020/07/14(火) 12:53

あほになる、ギリギリわかる年齢です笑

コードですが現在このようになっています。
挿入した画像の枚数をカウントする方法がわからず困っています...

Sub 画像貼り付け()

Dim lngTop As Long
Dim objFile As Object
Dim objFldr As FileSystemObject
Dim TheShape As Shape
Dim i As Integer

    Set objFldr = CreateObject("Scripting.FileSystemObject")

    lngTop = 45

    For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\picture").Files

        ActiveSheet.shapes.AddPicture _
                Filename:=objFile, _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=11, _
                Top:=lngTop, _
                Width:=250, _
                Height:=150
                i = 0
                i = i + 1

          If i Mod 4 = 1 Then

            lngTop = lngTop + 150 + 50

         Else
             lngTop = lngTop + 150 + 15
         End If
    Next

End Sub
（nai） 2020/07/14(火) 14:26

 >i = 0
 >i = i + 1

 ループの中でカウンタを初期化しちゃってますよ。

 i = 0 を
 For Each objFile ～
 の前にしてください。
（OK） 2020/07/14(火) 14:30

無事に動かすことができました。

本当にありがとうございます。
（nai） 2020/07/14(火) 17:49

コメント返信：

[ 一覧(最新更新順) ]

[[20200714115907]] 『VBAで画像貼り付けの位置指定したい』（nai） ページの最後に飛ぶ

[[20200714115907]]　『VBAで画像貼り付けの位置指定したい』（nai）　ページの最後に飛ぶ