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, 65End 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 = msoFalseEnd With'POPULATE SIGNATURE IMAGE ON SAME SHEETWith ActiveSheet.Shapes("Picture 2").Fill.Visible = msoTrue.UserPicture strFileToOpen.TextureTile = msoFalseEnd With'POPULATE SIGNATURE IMAGE ON A DIFFERENT SHEETWith Sheets("Sheet2").Shapes("Picture 1").Fill.Visible = msoTrue.UserPicture strFileToOpen.TextureTile = msoFalseEnd With
End Sub
I would very much appreciate any assistance or advise in regards to this issue.
Regards,
Bookmarks