VBA

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

VBA - 在 excel 中调整图片大小

VBA - Resizing a picture in excel

excel

image

userform

transfer