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

将图片水平放置在中心

1 个答案: