Resizing Multiple Pictures to fit cells

[zai90]

Hi All,

I have been trying to alter a code which I previously saw but to no avail...
basically, i am trying to resize all SELECTED pictures to fit into the size of the cells which I have wanted.
however while I can do for one pic at a time with the needed result, I cannot do it if I selected multiple pictures...
any idea why?? I have pasted the code below for all the experts out there to help me solve the mystery...

Public Sub FitPic()
On Error GoTo NOT_SHAPE

Dim pic As Picture
If TypeName(Selection) = "DrawingObjects" Then
For Each pic In Selection
FitIndividualPic pic
Next pic
Else
FitIndividualPic Selection
End If
Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro." & " Num" & count
End Sub

Public Sub FitIndividualPic(pic As Object)
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
Dim Gap As Single
Gap = 3
With pic
PicWtoHRatio = (.Width / .Height)
End With
With pic.TopLeftCell
CellWtoHRatio = .Width / .RowHeight
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is > 1
With pic
.Width = .TopLeftCell.Width - Gap
.Height = .Width / PicWtoHRatio - Gap
End With
Case Else
With pic
.Height = .TopLeftCell.RowHeight - Gap
.Width = .Height * PicWtoHRatio - Gap
End With
End Select
With pic
.Top = .TopLeftCell.Top + Gap
.Left = .TopLeftCell.Left + Gap
End With
End Sub

 

[tygrrboi]

my guess is that you're passing the wrong data...

Also I'm not sure what your If statement is trying to accomplish... If its a drawing object then pass the entire selection to FitIndividualPic?

Finally with your error statement... Once you go to NOT_SHAPE, you do not go back inside the loop... So I do not see what your count is trying to do. The variable count is never defined or set to anything so I assume it just says something like "Num0" or just "Num" each time. Personally I would put this error catching message inside the FitIndividualPic macro so it checks for each picture.

If you replace your first sub with this, does it work?

[COLOR=#333333]Public Sub FitPic()[/COLOR]

[COLOR=#333333]Dim pic As [/COLOR][COLOR=#ee82ee]Object[/COLOR][COLOR=#333333][/COLOR]

[COLOR=#333333]For Each pic In Selection[/COLOR]
[COLOR=#333333]FitIndividualPic pic[/COLOR]
[COLOR=#333333]Next pic[/COLOR]

[COLOR=#333333]End Sub

[/COLOR]

 

[zai90]

I tried to pass the object as object however it doesn't change much, except that this time, some of the selected pictures got resized, while most of it remains in its original size. Puzzling...

any more advice?

my guess is that you're passing the wrong data...

Also I'm not sure what your If statement is trying to accomplish... If its a drawing object then pass the entire selection to FitIndividualPic?

Finally with your error statement... Once you go to NOT_SHAPE, you do not go back inside the loop... So I do not see what your count is trying to do. The variable count is never defined or set to anything so I assume it just says something like "Num0" or just "Num" each time. Personally I would put this error catching message inside the FitIndividualPic macro so it checks for each picture.

If you replace your first sub with this, does it work?

[COLOR=#333333]Public Sub FitPic()[/COLOR]

[COLOR=#333333]Dim pic As [/COLOR][COLOR=#ee82ee]Object[/COLOR]

[COLOR=#333333]For Each pic In Selection[/COLOR]
[COLOR=#333333]FitIndividualPic pic[/COLOR]
[COLOR=#333333]Next pic[/COLOR]

[COLOR=#333333]End Sub

[/COLOR]

 

[tygrrboi]

Are all of your pictures actual pictures? Or are you selecting some shapes or other things as well?

Also.. what do your cells look like? Are some Merged? When you try to fit a picture to the top left cell of a merged group of cells, it would only resize it to the proportions of that single-cell portion of the merged cell...

Without seeing your actual document though it is pretty hard to say what's going on.

 

[zai90]

all my image are all actual pictures, none of my cells are merged.

just to make it clearer, when I select an individual picture and resize it, it goes well, it's only when I select multiple pictures that the outcome is very random.

Are all of your pictures actual pictures? Or are you selecting some shapes or other things as well?

Also.. what do your cells look like? Are some Merged? When you try to fit a picture to the top left cell of a merged group of cells, it would only resize it to the proportions of that single-cell portion of the merged cell...

Without seeing your actual document though it is pretty hard to say what's going on.

 

[tygrrboi]

Just out of curiosity, what happens when you set your gap variable to 0... The reason I ask is it does not seem to follow the logic that I assume you want...

Namely..

Setting the Height is cell height - gap. Ok thats fine...
but then setting the Width to the proportion of its new height (height * PicWtoHRatio) should give you exactly what you want and there is no need to subtract the gap from this...

The same goes for setting the Width first and using the proportion to find the height.

Also. When you position it in the cell (top and left) You probably would want to center it... meaning that you would take the cell top and the cell width + HALF of the gap... or Gap/2...

Instead of trying to make changes to the arithmetic in the macro (because I could be wrong)... just try setting the Gap to 0 instead of 3 to test what I assume is mucking up your sizing function...

 

[tygrrboi]

I finally got around to actually testing the macros on an actual document with images (even shapes and text boxes...)

And when I removed the IF statement and the Error pointer, it works just fine...

If you are running into trouble with the For Each loop you might just try a standard for loop. (This way you do not have to set the type of selection - picture/object/shape/etc...)

Public Sub FitPic()

[COLOR=#ff0000]Dim i As Long[/COLOR]

[COLOR=#ff0000]For i = 1 to Selection.Count[/COLOR]
FitIndividualPic [COLOR=#ff0000]Selection(i)[/COLOR]
Next [COLOR=#ff0000]i[/COLOR]

End Sub