paste - H3m1sphere/test GitHub Wiki

理解しました。画像を配置する際に、前の画像の右端から5ポイント開けて次の画像を配置するように修正する必要があります。この要件を満たすために、各画像の位置を前の画像の位置とサイズに基づいて動的に計算する必要があります。

以下は、画像を適切に配置するための修正されたVBAコードです。このコードでは、前の画像の右端から5ポイントの間隔を開けて次の画像を配置し、列の最後に到達したら次の行に移動します。

Sub 画像を貼り付ける()
    Dim imgPath As Variant
    Dim startCell As Range
    Dim img As Picture
    Dim i As Integer
    Dim columnCount As Integer
    Dim rowCount As Integer, columnOffset As Integer
    Dim nextLeft As Double, nextTop As Double, maxHeightInRow As Double

    ' 画像ファイルの選択
    imgPath = Application.GetOpenFilename("画像ファイル (*.jpg;*.gif;*.png), *.jpg;*.gif;*.png", MultiSelect:=True)
    If IsArray(imgPath) = False Then Exit Sub ' ユーザーがキャンセルした場合

    ' 貼り付けを開始するセルと列数を入力
    Set startCell = Application.InputBox("開始セルを選択してください", Type:=8)
    columnCount = Application.InputBox("列数を入力してください", Type:=1)

    ' 画像の貼り付け
    rowCount = 0
    columnOffset = 0
    maxHeightInRow = 0
    nextLeft = startCell.Left
    nextTop = startCell.Top

    For i = LBound(imgPath) To UBound(imgPath)
        Set img = ActiveSheet.Pictures.Insert(imgPath(i))
        With img
            .Left = nextLeft
            .Top = nextTop
            .Placement = xlMoveAndSize

            ' 次の画像の位置を計算
            nextLeft = .Left + .Width + 5 ' 5ポイントの間隔を追加
            If .Height > maxHeightInRow Then maxHeightInRow = .Height
        End With

        columnOffset = columnOffset + 1
        If columnOffset >= columnCount Then
            ' 次の行へ移動
            columnOffset = 0
            nextTop = nextTop + maxHeightInRow + 5 ' 5ポイントの間隔を追加
            nextLeft = startCell.Left
            maxHeightInRow = 0
        End If
    Next i
End Sub

このコードは、各画像が前の画像の右端から5ポイントの間隔を開けて配置されることを保証します。また、指定された列数に達したら、次の行に移動して再び配置を開始します。これにより、画像が適切に配置され、重なり合うことなく整然としたレイアウトになるはずです。