Private Sub CommandButton2_Click()
Call PictureToCell(UserForm1.Image1, ActiveSheet.Range("B2"))
End Sub
Private Sub PictureToCell(PictureControl, Cell As Range, Optional InCell As Boolean = True)
Dim FSO As Object
Dim FullName As String
Dim Picture As Object
Dim Sh As Shape
Dim Ratio As Single
Dim Width As Single
Dim Height As Single
Const TemporaryFolder = 2
'Delete existing picture at destination or same name
For Each Sh In Cell.Parent.Shapes
If Sh.Name = PictureControl.Name _
Or (Sh.Top = Cell.Top And Sh.Left = Cell.Left) Then Sh.Delete
Next Sh
'Save Picture to temporary folder
Set FSO = CreateObject("scripting.filesystemobject")
FullName = FSO.GetSpecialFolder(TemporaryFolder).Path & "\" & FSO.gettempname
SavePicture PictureControl.Picture, FullName
'Image size
If InCell Then
Ratio = Application.Min(Cell.MergeArea.Width / PictureControl.Width, Cell.MergeArea.Height / PictureControl.Height)
Else
Ratio = 1
End If
Width = PictureControl.Width * Ratio
Height = PictureControl.Height * Ratio
'Insert Picture in the Worksheet
Set Sh = Cell.Parent.Shapes.AddShape(msoShapeRectangle, Cell.Left, Cell.Top, Width, Height)
Sh.Name = PictureControl.Name
Sh.Fill.UserPicture FullName
'delete temporary file
FSO.deletefile FullName
End Sub