Положение изображения горизонтально в центре

Question

Я хочу разместить изображение в центре диапазона, но он просто не работает для меня. Может быть, кто-нибудь знает, как это сделать? Вот мой код:

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) 
Dim p As Object, t As Double, l As Double, r As Double, b As Double 
Dim aspect 
Dim w, h 
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
If Dir(PictureFileName) = "" Then Exit Sub 
l = 1: r = 22 ' co-ordinates of top-left cell 
t = 47: b = 88 ' co-ordinates of bottom-right cell 
Set TargetCells = Range("A47:V88") 
Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
With p 
    With .ShapeRange 
      .LockAspectRatio = msoTrue ' lock the aspect ratio (do not distort picture) 
      aspect = .Width/.Height  ' calculate aspect ratio of picture 
      .Left = Cells(t, l).Left  ' left placement of picture 
      .Top = Cells(t, l).Top  ' top left placement of picture 
    End With 
    w = (Cells(b, r).Left + Cells(b, r).Width - Cells(t, l).Left) ' width of cell range 
    h = Cells(b, r).Top + Cells(b, r).Height - Cells(t, l).Top  ' height of cell range 
    If (w/h < aspect) Then 
     .ShapeRange.Width = w   ' scale picture to available width 
    Else 
     .ShapeRange.Height = h   ' scale picture to available height 
    End If 
    .Placement = 1 
End With 

Set p = Nothing 
End Sub 

Answer 1

Обнаруженные ответ:

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) 
    Dim p As Object, t As Double, l As Double, r As Double, b As Double 
    Dim aspect 
    Dim w, h 
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
    If Dir(PictureFileName) = "" Then Exit Sub 
    l = 1: r = 22 ' co-ordinates of top-left cell 
    t = 47: b = 88 ' co-ordinates of bottom-right cell 
    Set TargetCells = Range("A47:V88") 
    Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
    With p 
     With .ShapeRange 
       .LockAspectRatio = msoTrue ' lock the aspect ratio (do not distort picture) 
       aspect = .Width/.Height  ' calculate aspect ratio of picture 
       .Left = Cells(t, l).Left + TargetCells.Width/2 - p.Width/2  ' left placement of picture 
       .Top = Cells(t, l).Top  ' top left placement of picture 
     End With 
     w = (Cells(b, r).Left + Cells(b, r).Width - Cells(t, l).Left) ' width of cell range 
     h = Cells(b, r).Top + Cells(b, r).Height - Cells(t, l).Top  ' height of cell range 
     If (w/h < aspect) Then 
      .ShapeRange.Width = w   ' scale picture to available width 
     Else 
      .ShapeRange.Height = h   ' scale picture to available height 
     End If 
     .Placement = 1 
    End With 

    Set p = Nothing 
End Sub