EXCEL, PICTURE SHAPE, VBA: Fit Picture Proportionately Inside a Fixed Sized Picture Shape

I am building a dashboard that allows for dynamic input and this includes adding and changing a signature image (gif format with transparent background)
that will be used on multiple worksheets throughout the workbook using picture shapes. All picture shapes, including the primary on the dashboard
(first sheet) are added using the following utility code at the time of constructing the form. Once the picture shape is added, the utility code is no
longer necessary.

Private Sub btnInitPicShape_Click()
'THIS APPROACH IS USED INSTEAD OF SIMPLY ALLOWING THE USER TO LOAD THEIR FIRST PREFERRED SIGNATURE
'IMAGE BECAUSE ***FOR SOME REASON*** THE FIRST IMAGE SELECTED AND LOADED INTO A PICTURE SHAPE REMAINS
'AS A TOP LAYERED IMAGE NO MATTER WHAT SUBSEQUENT IMAGE IS SELECTED AND LOADED. UNTIL I FIND ANOTHER
'SOLUTION, I HAVE OPTED TO ADD THIS UTILITY CODE AND ITS HOST BUTTON (LATER HIDDEN) TO EACH PERTINENT
'SHEET. WHERE NECESSARY THIS CODE IS RUN TO ADD A SIGNATURE IMAGE.

ActiveSheet.Shapes.AddPicture "C:\{path}\EmptyTransparent.gif", True, True, 100, 100, 215, 65

End Sub


The following code is what I use, for now, to allow the user to select and load their preferred signature image. It indeed does the job of loading the
selected image however, and this is my problem with which I need help: I cannot find a way to size the signature image to fit within the picture shape
(retaining the shape's size) but without distorting the image's in either the horizontal or vertical directions. In other words, I need the signatures
to fit proportionately inside the statically sized and placed pictures shapes. Similar to the fmPictureSizeModeZoom setting for the PictureSizeMode for
an ActiveX control.

Sub Picture1_Click() ' ActiveSheet.'PICTURE 1' is the primary signature image
Dim strFileToOpen
strFileToOpen = Application.GetOpenFilename(Title:="Select GIF Signature File", FileFilter:="GIF Files *.gif* (*.gif*),")

'(ADD FILE VALISATION ERROR HANDLING CODE HERE)

'GET SIGNATURE FILE (TRANSPARENT GIF)

With ActiveSheet.Shapes("Picture 1").Fill

.Visible = msoTrue

.UserPicture strFileToOpen

.TextureTile = msoFalse

End With

'POPULATE SIGNATURE IMAGE ON SAME SHEET

With ActiveSheet.Shapes("Picture 2").Fill

.Visible = msoTrue

.UserPicture strFileToOpen

.TextureTile = msoFalse

End With

'POPULATE SIGNATURE IMAGE ON A DIFFERENT SHEET

With Sheets("Sheet2").Shapes("Picture 1").Fill

.Visible = msoTrue

.UserPicture strFileToOpen

.TextureTile = msoFalse

End With

End Sub

I would very much appreciate any assistance or advise in regards to this issue.

Regards,

Can I ask why don't you use ActiveX Image controls instead of Picture objects?

Kenneth et al:

Thank you for your help. Attached find my solution:

Please Login or Register  to view this content.