Reputation: 183
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.
Upvotes: 0
Views: 4980
Reputation: 870
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
Upvotes: 0
Reputation: 166790
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
Upvotes: 2