suznal


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¡­

Code Snippet
Private Sub CommandButton4_Click()
'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

Any ideas on how to fix my dilemma



Re: Excel - Resize image to specified target cells' dimensions

bi-lya


Hi again, Suznal

You need take only OR height OR width.

OR if you want to fit to dimension of cell (or MergeCells) - test following:

Code Snippet

Private Sub CommandButton4_Click()
Dim PicLocation As String
Dim MyRange As String

ActiveSheet.Unprotect
Range("A9").Select
MyRange = Selection.Address

PicLocation = Application.GetSaveAsFilename("C:\", "Image Files (*.jpg),*.jpg", , "Specify Image Location")

If PicLocation <> "False" Then
ActiveSheet.Pictures.Insert(PicLocation).Select
Else
Exit Sub
End If

With Selection.ShapeRange
.LockAspectRatio = msoTrue
If .Width > .Height Then
.Width = Range(MyRange).Width
If .Height > Range(MyRange).Height Then .Height = Range(MyRange).Height
Else
.Height = Range(MyRange).Height
If .Width > Range(MyRange).Width Then .Width = Range(MyRange).Width
End If
End With

With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With

Range("H16").Select
ActiveSheet.Protect
End Sub

And - IMHO - you may make one button on some CommandBars instead of hundreds buttons on sheets






Re: Excel - Resize image to specified target cells' dimensions

Cringing Dragon

This is not related to your problem, but is there a reason you're using

Application.GetSaveAsFilename

instead of

Application.GetOpenFilename

when it appears you're using the result to access an existing file rather than write one

It won't make any difference to the functionality, but the Open dialog box may be a little clearer for the user.







Re: Excel - Resize image to specified target cells' dimensions

suznal

Thanks bi-lya, I'm going to give it a try after lunch.

As far as the single versus multiple buttons... The company I work for is ISO and this workbook is being made per specifications mandated in a procedure, every instance of a range to include an image must have it's own command button. I don't make the rules here, I just get paid if I follow them!






Re: Excel - Resize image to specified target cells' dimensions

suznal

Dragon, no there is no reason other than I have been too busy to think. Thanks for pointing it out though, since I'm making other changes to the code I'll incorporate your suggestions as well.