Вставка картинки в правильное положение - PullRequest
1 голос
/ 15 апреля 2020

Я использую код, который вставляет изображение (столбец A) соответствующего номера элемента, расположенного в столбце B.

Текущее расположение изображения:

Current positioning of the picture

Однако вставленные изображения расположены в верхнем левом углу каждой ячейки, и я хотел бы, чтобы они были в центре ячейки немного ниже линии ячейки. (размер ячейки 54, а изображение 50).

Вот код, который я использую:

Sub InsertImageFullName()

On Error Resume Next

Application.ScreenUpdating = False

Dim path$, cl As Range, myPicture As Object

Set Rng = Range("A2:A300")

cell_h = Range("A2").Top - Range("A1").Top 

For Each cl In Rng
  path = cl.Offset(0, 8).Value 
  If path Like "*?*" Then
    Set myPicture = ActiveSheet.Pictures.Insert(path) 
    With myPicture 
      .ShapeRange.LockAspectRatio = msoTrue 
      .Height = 50 
      .Top = Rows(cl.Row).Top
      .Left = Columns(cl.Column).Left
    End With
  End If
  Set myPicture = Nothing
Next 

End Sub

Что нужно изменить, чтобы это работало?

Любая помощь очень ценится

Ответы [ 3 ]

0 голосов
/ 15 апреля 2020

Чтобы установить положение изображения, вам нужно отрегулировать его верхнее и левое положение.

.Top = Rows(cl.Row).Top
.Left = Columns(cl.Column).Left

Так что вам просто нужно что-то добавить. Таким образом, если ваша высота ячейки равна 54, а высота вашей картинки равна 50, и ваша картинка должна быть отцентрирована, то количество, которое вам нужно добавить, рассчитывается как add = (CellHeight - PictureHeight) / 2, равное (54 - 50) / 2, равное 2, поэтому вам нужно добавить 2 в положение .Top:

.Top = Rows(cl.Row).Top + 2 'add 2 to the top position of your picture.
0 голосов
/ 15 апреля 2020

Вы знаете ширину и высоту изображения по myPicture.Width и myPicture.Height. И ширина и высота ячейки на cl.Width и cl.Height

Верхняя позиция изображения Cell top + (Cell top - Image Height) / 2 Левая позиция изображения Cell left + (Cell left - Image Width) / 2

Так что вам нужно изменить код с

    .Top = Rows(cl.Row).Top
    .Left = Columns(cl.Column).Left
End With

К

    .Top = cl.Top + (cl.Height - myPicture.Height) / 2
    .Left = cl.Left + (cl.Width - myPicture.Width) / 2
End With
0 голосов
/ 15 апреля 2020

Попробуйте использовать Вертикальное выравнивание и Горизонтальное выравнивание на объекте Range для правильного выравнивания содержимого ячейки.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...