VBA - динамическая вставка JPG по заданным c координатам ячейки

Question

Я хотел бы знать, как динамически вставить файл изображения в определенные c координаты ячейки. Я пытался с этим кодом, но он вставляет изображение в абсолютном месте.

            With ActiveSheet.Pictures.Insert("C:\Users\zkumh45\Documents\StoryJPG.jpg")
                .Left = ActiveSheet.Range("A1").Left
                .Top = ActiveSheet.Range("A1").Top
                .Placement = 1
            End With

Тем не менее, я записал с помощью макроса, и это то, что я получил:

Sub Macro1() 
   Selection.ShapeRange.IncrementLeft 37.5
   Selection.ShapeRange.IncrementTop 50.25
End Sub

Это то, что У меня сейчас:

Вот что я хочу:

Красный и фиолетовый тексты заполняются динамически.

Answer 1

Как правило, вы можете вставить изображение в положение по умолчанию, а затем переместить его в соответствии со своими потребностями. Я бы инкапсулировал его в подпрограмму для удобства

Например, если цель состоит в том, чтобы расположить изображение так, чтобы его верхний правый угол совпал с верхним левым углом ячейки, вы бы использовали это

Sub PlaceImage(rng As Range, Pic As String)
    Dim p As Picture

    Set p = rng.Worksheet.Pictures.Insert(Pic)

    With p
        .Left = rng.Left - p.Width
        .Top = rng.Top
        .Placement = 1
    End With
End Sub

Sub Demo()
    PlaceImage ActiveCell, "C:\Users\zkumh45\Documents\StoryJPG.jpg"

End Sub

Answer 2

К сожалению, я не знаю хорошего способа получить вещи именно там, где вы хотите, чтобы они были, но, вероятно, этого будет достаточно. У меня также нет вашего точного изображения, так что вам, возможно, придется внести некоторые изменения.

Dim placerange as range
dim placeleft as long
dim placetop as long

set placerange = range("A2")
placeleft = (placerange.left + placerange.offset(0, 1).left) * .66 'Mess with this number, probably between .5 - .66 for that picture size
placetop = placerange.top

With ActiveSheet.Pictures.Insert("C:\Users\zkumh45\Documents\StoryJPG.jpg")
    .left = placeleft
    .top = placetop
    .Placement = 1
End With