VBA - Resizing a picture in Excel

[Estevam Guilherme]

The code bellow paste the picture from my form into Excel. But, how can I past the pic in the activecell?
by the way, I got this code rigth here. Copy image in userform to a worksheet

Private Sub UserForm_Activate()
    PicToSheet Me.Image1, ActiveSheet
End Sub

Private Sub PicToSheet(picControl, sht As Worksheet)
    Dim p As String, L As Double, T As Double, H As Double
    p = ThisWorkbook.Path & "\" & Format(Now, "yymmdd hhmmss") & "bmp"
'save temporary image to folder
    SavePicture picControl.Picture, p
'embed image in sheet
    L = sht.Cells(1, 12).Left: T = sht.Cells(1, 12).Top
    With sht.Shapes.AddPicture(Filename:=p, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=L, Top:=T, Width:=50, Height:=50)
        .Placement = xlMove
        .OLEFormat.Object.PrintObject = msoTrue
        .OLEFormat.Object.Locked = msoTrue
    End With
'delete temporary file
    Kill p
End Sub

 

[GWteB]

See if this works for you ...

Private Sub UserForm_Activate()

    Dim Shp As Shape
    Set Shp = PicToSheet(Me.Image1, ActiveSheet)
    Shp.Top = ActiveCell.Top
    Shp.Left = ActiveCell.Left

End Sub


Private Function PicToSheet(picControl, sht As Worksheet) As Shape
    Dim p As String, L As Double, T As Double, H As Double
    p = ThisWorkbook.Path & "\" & Format(Now, "yymmdd hhmmss") & "bmp"
'save temporary image to folder
    SavePicture picControl.Picture, p
'embed image in sheet
    Set PicToSheet = sht.Shapes.AddPicture(Filename:=p, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=1, Top:=1, Width:=50, Height:=50)
    With PicToSheet
        .Placement = xlMove
        .OLEFormat.Object.PrintObject = msoTrue
        .OLEFormat.Object.Locked = msoTrue
    End With
'delete temporary file
    Kill p
End Function

 

[Estevam Guilherme]

Man, you're such a genius.
Thank you a lot.

 

[GWteB]

Glad it works and thank you for the feedback