将图片从用户窗体复制到电子表格

Question

我将图片加载到包含在用户窗体中的图像控件中。我想从用户窗体图像控件复制图片并将其粘贴到电子表格中。我找到了一种在电子表格中创建 OLEObject 并以这种方式移动图像的方法 here ，但我正在创建多个电子表格并且我不想要所有额外的对象。

如果我进入 VBA 编辑器，进入用户窗体，进入图像控件，并使用我的鼠标，select 图片属性中的（位图）并复制它，我可以只将图片粘贴到电子表格中。

如果我用宏录制器来做同样的事情，代码自然就只有select和粘贴方法了。如果我在代码中引用相同的图片属性，我得到的只是句柄。

我搜遍了，我相信穷尽了，我在VBA中找不到任何编程抓取句柄和粘贴图片的方法。我对 VBA 还很陌生，API 级别的工作远远超出了我目前的能力范围。

Answer 1

您可以导出到临时文件并从那里加载：

Private Sub UserForm_Activate()

    TransferToSheet Me.Image1, Sheet1

End Sub

Private Sub TransferToSheet(picControl, sht As Worksheet)
    Const TemporaryFolder = 2
    Dim fso, p
    Set fso = CreateObject("scripting.filesystemobject")
    p = fso.GetSpecialFolder(TemporaryFolder).Path & "\" & fso.gettempname
    SavePicture picControl.Picture, p
    sht.Pictures.Insert p
    fso.deletefile p
End Sub

Answer 2

Tim Williams 使用 Pictures.Insert 方法的解决方案会在图像中插入 link。如果要将图像嵌入到工作表中，最好使用 shape 对象，如 here 所述。我更改了@Tim Williams 代码以粘贴到 Range 而不是 worksheet 并添加了一个部分以删除目标范围内预先存在的形状。

Private Sub TransferToRange(picControl, destRange As Range)

    Const TemporaryFolder = 2

    Dim shp As Shape
    Dim ws As Worksheet
    Dim fso As Variant
    Dim p As String

    Set ws = destRange.Parent

    '
    ' delete visible shapes of picture type at the destRange position
    '
    For Each shp In ws.Shapes
        ' picture
        If shp.Type = msoPicture Then
            ' visible
            If shp.Visible = msoTrue Then
                ' position
                If shp.Top = destRange.Top And shp.Left = destRange.Left Then
                    shp.Delete
                End If
            End If
        End If
    Next

    '
    ' Save Form.Image.Picture to temporary folder
    '
    Set fso = CreateObject("scripting.filesystemobject")
    p = fso.GetSpecialFolder(TemporaryFolder).Path & "\" & fso.gettempname
    SavePicture picControl.Picture, p

    '
    ' Add a Shape-Object to hold a picture
    '
    With ws.Shapes.AddPicture(Filename:=p, linktofile:=msoFalse, _
            savewithdocument:=msoCTrue, Left:=destRange.Left, Top:=destRange.Top, Width:=-1, Height:=-1)
        '
        ' additional settings - if required
        '
        .Placement = xlMove
        .OLEFormat.Object.PrintObject = msoTrue
        .OLEFormat.Object.Locked = msoTrue
    End With

    '
    ' delete temporary file
    '
    fso.deletefile p

End Sub

将图片从用户窗体复制到电子表格

Copy picture from userform to spreadsheet

excel

vba

userform