Question

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

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

如果我使用宏录制器执行相同操作，代码自然只包含选择和粘贴方法。如果我在代码中引用相同的图片属性，我得到的就是句柄。

我已经进行了广泛的搜索，我完全相信，而且我无法找到任何以编程方式抓取句柄并在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

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

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

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

2 个答案: