0

I have a picture loaded into an image control contained within a userform. I would like to copy the picture from the userform image control and paste it into a spreadsheet. I've found a means to create an OLEObject within the spreadsheet and move the image that way here , but I'm creating multiple spreadsheets and I don't want all the extra objects.

If I go into the VBA Editor, into the userform, into the image control, and using my mouse, select the (Bitmap) in the Picture property and copy it, I can paste just the picture into a spreadsheet.

If I use the macro recorder to do the same, the code naturally only includes the select and paste methods. And if I reference the same picture property within code, all I get back is the handle.

I have searched extensively, and I believe exhaustively, and I can't find any means of programmatically grabbing the handle and pasting the picture in VBA. I'm fairly new to VBA as it is and API level work is well beyond my current abilities.

Community
  • 1
  • 1
pondersome
  • 183
  • 1
  • 9
  • How does the picture get into the image control in the first place? – Tim Williams Sep 15 '16 at 22:12
  • Do you have sample code that you can share that's not working? Somehting that shows the image control name in the userform, and the target worksheet cell? – dbmitch Sep 15 '16 at 22:12
  • @ Tim Williams, The picture is manually loaded into the userform. The picture can change as needed so the form is a local resource rather than writing a path to an image stored on the network. – pondersome Sep 15 '16 at 22:18
  • @dbmitch, this code works Dim LogoFile As Variant Set LogoFile = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _ DisplayAsIcon:=False, Left:=0, Top:=0, Width:=100, Height:=50) With LogoFile.Object .BackStyle = fmBackStyleTransparent .BorderStyle = fmBorderStyleNone End With LogoFile.Object.Picture = Logos.Black.Picture Unfortunately, any effort to copy from Logos.Black.Picture returns only the handle. Sorry for my poor formatting, I'm new to this and I haven't figured out how to crlf yet. – pondersome Sep 15 '16 at 22:22
  • 3
    Don't paste it into comments - paste it into formatted tags in your question – dbmitch Sep 15 '16 at 22:25
  • Press enter twice if you want a line break. –  Sep 15 '16 at 22:43

2 Answers2

2

You can export to a temporary file and load from there:

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • Well done. I changed the worksheet `sht` to a range object for exact positioning and added a loop to delete `pictures` that exist at the same `topLeftCell.Address` – DrMarbuse Sep 17 '18 at 16:35
  • Well done. More general to use `TransferToSheet Me, ActiveSheet` – Noam Brand Dec 06 '22 at 23:22
0

Tim Williams solution with the Pictures.Insert method inserts a link to the image. If the image is to be embedded into the worksheet, it is better to use a shape object, as described here. I changed @Tim Williams code to paste to a Range rather than a worksheet and added a part to delete pre-existing shapes at the destination 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
DrMarbuse
  • 804
  • 11
  • 30