VBAで画像を指定場所に張り付けたいです。

Question

失礼しました。
再投稿です。

VBAで画像を指定場所に張り付けたいです。
VBA超初心者です。

画像を任意のフォルダから順番に張り付けるコードを作成したいです。
現在、挿入画像の座標をポイントで指定してますが頑張っても微妙にセルからずれてしまい困っています。

そこで画像の上部は任意のセルの上部に合わせ、行方向の位置はポイントで指定することはできますでしょうか。

画像を等間隔で４枚並べ、５枚目は４枚目と別の間隔で並べる
・・・写真四枚の塊が縦方向にいくつかあるようなものをつくっています。

初心者のため、現在のコードを大きく変えることなく出来れば嬉しいです。

宜しくお願いいたします。

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 = 47.5 

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

ActiveSheet.shapes.AddPicture _
 Filename:=objFile, _
 LinkToFile:=False, _
 SaveWithDocument:=True, _
 Left:=11, _
 Top:=lngTop, _
 Width:=252.834, _
 Height:=188.5 

i = i + 1 

If i Mod 4 = 0 Then 

lngTop = lngTop + 188.5 + 80 

Else
 lngTop = lngTop + 188.5 + 16.05
 End If
 Next 

Comments

[y_waiwai]

このままではコードが読みづらいので、質問を編集し、<code>ボタンを押し、出てくる’’’の枠の中にコードを貼り付けてください

Answer 1

セルにぴったり合わせたいというのであれば、座標をポイント計算するではなく、セルの座標を利用したほうがよいのでは。
以下のコードは4列x10行を1枚分の画像領域として等間隔（全列幅と行高さをそろえておく必要あり）に配置します。

Sub 画像貼り付け()

	Dim objFile As Object
	Dim objFldr As FileSystemObject
	Dim TheShape As Shape
	Dim i As Integer
	Dim x, y As Integer
	Dim r, c As Integer

    Const X_NUM = 4			' 横にいくつ画像を並べるか
    Const X_COLS = 5		' １枚の画像とする列数
    Const Y_ROWS = 10		' １枚の画像とする行数

	Set objFldr = CreateObject("Scripting.FileSystemObject")

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

        r = Int(i / X_NUM) * X_COLS + 1		' セル位置(行)を計算
        c = (i Mod X_NUM) * Y_ROWS + 1		' セル位置(列)を計算
        x = ActiveSheet.Cells(r, c).Left	' セルの座標(X)を取得
        y = ActiveSheet.Cells(r, c).Top		' セルの座標(Y)を取得

		ActiveSheet.shapes.AddPicture _
			Filename:=objFile, _
			LinkToFile:=False, _
			SaveWithDocument:=True, _
			Left:=x, _
			Top:=y, _
			Width:=252.834, _
			Height:=188.5

		i = i + 1
	Next

End Sub

Comments

[tanetanetane]

ご丁寧にありがとうございます。

画像を縦に4枚で1セット、さらにそれを縦に並べたいです。
■
■
■
■

■
■
■
■
このような感じです。

早速いただいたコードをいじってみました。
画像と画像の縦方向の間隔のサイズはどのようにすれば良いのでしょうか。
セルの個数で間隔を指定したいと思っています。

よろしくお願いいたします。

[ttyp03]

もう解決済みになってしまいましたが、一応コメントを。

すみません、縦に４つ並べて１つのグループなのですね。
質問内容を取り違えていました。
いずれにしてもrとcの計算式を変更すれば対応可能と思いますのでお試しください。

[tanetanetane]

ご丁寧にありがとうございました。
なんとかなりそうです。
本当にありがとうございました！