返回列表 上一主題 發帖

插入圖片時,等比例放大或縮小

Set rngs = Range(Cells(61, 2), Cells(61, 19))
With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)
     .LockAspectRatio = msoFalse
     If .Width > rngs.Width - 4 Then .Width = rngs.Width - 4
     If .Height > rngs.Height - 4 Then .Height = rngs.Height - 4
     .Left = rngs.Left + (rngs.Width - .Width) / 2
     .Top = rngs.Top + (rngs.Height - .Height) / 2
End With

TOP

回復 18# takeshilin88


.LockAspectRatio = True

TOP

回復 20# takeshilin88


.LockAspectRatio = msoTrue
或
.shaperange.LockAspectRatio = msoTrue


再不行的話, 要有檔案才能了解問題何在

TOP

回復 20# takeshilin88


或者, 原圖比存放位置小, 變成要"放大":
Set rngs = Range(Cells(61, 2), Cells(61, 19))
With ActiveSheet.Shapes.AddPicture(i, False, True, rngs.Left, rngs.Top, True, True)
     .LockAspectRatio = msoFalse
     .Width = rngs.Width - 4
     .Height = rngs.Height - 4
     .Left = rngs.Left + (rngs.Width - .Width) / 2
     .Top = rngs.Top + (rngs.Height - .Height) / 2
End With

TOP

本帖最後由 准提部林 於 2020-10-12 15:19 編輯

回復 24# takeshilin88

試了如圖:


Sub test()
Dim rngs As Range
Set rngs = [B61:S61]
With ActiveSheet.Shapes("圖片 1")
      .LockAspectRatio = True
      If .Width >= .Height Then .Width = rngs.Width - 4
      If .Height >= .Width Then .Height = rngs.Height - 4
      If .Width > rngs.Width - 4 Then .Width = rngs.Width - 4
      If .Height > rngs.Height - 4 Then .Height = rngs.Height - 4
      .Left = rngs.Left + (rngs.Width - .Width) / 2
      .Top = rngs.Top + (rngs.Height - .Height) / 2
End With
End Sub

'===============

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題