VBA -在excel中调整图片大小

Question

下面的代码将图片从我的表单粘贴到一个活动单元格中。但是，我如何将过去的图片调整到excel中?

Private Sub CommandButton1_Click()
TransferToSheet Me.Image1, Plan2, 350
End Sub
Private Sub TransferToSheet(picControl, sht As Worksheet, picWidth As Long)
Const TemporaryFolder = 2
Dim fso, p
Set fso = CreateObject("scripting.filesystemobject")
p = fso.GetSpecialFolder(TemporaryFolder).Path & "" & fso.gettempname
SavePicture picControl.Picture, p
With picControl.Picture.Insert(p)
.ShapeRange.LockAspectRatio = msoTrue
.Width = picWidth
End With

fso.deletefile p
Unload Me

结束子

Answer 1

好的-我修改了前面的答案来处理这个事实，即图片实际上是一个形状-你通过使用图像的ShapeRange来调整大小。

Private Sub CommandButton1_Click()
TransferToSheet Image1, Worksheets("Sheet1"), 350
End Sub

Private Sub TransferToSheet(picControl, sht As Worksheet, picWidth As Long)
Const TemporaryFolder = 2
Dim fso, p
Set fso = CreateObject("Scripting.FileSystemObject")
p = fso.GetSpecialFolder(TemporaryFolder).Path & "" & fso.gettempname
SavePicture picControl.Picture, p ' save to temp file

' Insert temp file inot new image
With sht.Pictures.Insert(p)
' Resize
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = picWidth
End With
End With

' Delete Temp File
fso.DeleteFile p
End Sub