I have a command button on a worksheet that calls up the ¡®getsaveasfilename¡¯ dialog, and inserts the selected image file into a merged range of cells. The images are automatically re-sized to fit into the cell (aspect ratio maintained). Everything works well, but I ran into a problem.
There are about 70 sheets in the workbook, and this command button can be found about 250 times throughout the workbook. I found out that the merged cells to contain the images vary in width and height throughout the workbook, even on the same sheet.
(By the way, I did not create the sheet, I was just asked to input the commands ¨C lucky me)
I do not want to go through every one and figure out the width and height for each cell on the worksheet and type in the corresponding values for every button, (it might take me weeks).
What would be helpful is if there were a way to write the code so that the image is resized to the size of the cell (it is actually a merged set of cells), that it is being placed into.
Essentially I need to maintain the aspect ratio of the image file, and fill the target cell(s) without exceeding their boundaries.
Attached is the code in it¡¯s present state¡
'before
ActiveSheet.Unprotect
Range("A9").Select
Dim PicLocation As String
PicLocation = Application.GetSaveAsFilename("C:\Windows\My Documents", "Image Files (*.jpg),*.jpg", , "Specify Image Location")
If PicLocation <> "False" Then
ActiveSheet.Pictures.Insert(PicLocation).Select
Else
Exit Sub
End If
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = 235#
Selection.ShapeRange.Height = 165#
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
Range("H16").Select
'after
ActiveSheet.Protect
End Sub