Word VBA to automatically resize pictures to fit remainder of page

[carlito_1985]

Hi all,

I'm looking to write a macro in word (2003) which will automatically resize any pictures in the document that have gone over the page. They will be resized to fit the blank space at the bottom of the previous page which wouldn't fit the picture at 100%.

To try and clarify my question further the document I'm working on frequently references pictures. If the picture at 100% is half a page and there's only a third of a page space at the bottom word would normally put this on the next page leaving a large amount of white space which I'm trying to get rid of. I'd like the macro to resize the picture to fit at the bottom of this page. The reduction would have to maintain the constraints so as to not distort the picture.

Additionally it wouldn't be able to reduce the photo's to less than 80% of the original size so as to maintain their legibility.

So it should be something like:

IF Remaining space on page > picture size at 80% then
Resize picture to required size
ELSE
Don't change anything.

Thanks all,

Andrew

[smallken]

Hi Carlito_1985,

Finding the vertical position of a selection on the page is notoriously difficult in Word.

My suggestion is a VBA macro to insert the picture then check if the picture is on the next page. If it is then reduce the size of the picture in say 5% steps until the picture is back on the original page. If the size is 80% and it is still going over the page then restore to original size.

The potential disadvantage of this method is that it may be slow for large documents.

If no one else has a better idea then I will cobble together some code and post.

[carlito_1985]

Hi smallken,

Thanks for your answer. I figured it would be quite difficult. I haven't really used VBA to automate word; I've mainly used in in excel which seems to be a lot easier as you deal with cell references and addresses as oppose to line and column references (which there still doesn't seem to be anything too obvious) etc.

Don't worry about going to the effort of writing some code. I think your suggestion to insert the picutre and check if it's on the right page might work well enough for what I am after.

Thank you for the suggestion and I'll give it a bash :)

[macropod]

Hi Carlito,

Here's something to get you started. You'll probably need to add extra code to:
1. constrain the minimum size the pic will be scaled down to (as coded, it might end up only 1pt high).
2. test whether there's already a shape in the space below the last word on the previous page (as coded, you could end up with multiple shapes being inserted there, or even an endless loop).
3. etc.

Sub PicResize()
Dim Shp As Shape, Rng As Range, ShpPos As Single, ShpHt As Single, SpcHt As Single
With ActiveDocument
For Each Shp In .Shapes
With Shp
'get the shape's position on the page
.RelativeHorizontalPosition = wdRelativeVerticalPositionPage
ShpPos = .Top
ShpHt = .Height
.LockAspectRatio = msoTrue
'Point to the page
Set Rng = .Anchor
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
With Rng
'Check whether the first character on the page follows the shape;
'if not, ignore this shape.
If .Characters.First.Information(wdVerticalPositionRelativeToPage) > ShpPos Then
'test the last character on the previous page. Don't do anything if they are.
.Start = .Start - 1
.End = .Start
.Select
With .Characters.First
If Asc(.Text) <> 12 Then 'Page break or Section break, so ignore this shape.
'Calculate the available space.
SpcHt = .Information(wdVerticalPositionRelativeToPage) _
+ .Paragraphs(1).SpaceAfter
With .PageSetup
SpcHt = .PageHeight - .TopMargin - SpcHt
End With
'Resize, then cut & paste to new location.
With Shp
.Height = SpcHt
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Top = wdShapeBottom
.WrapFormat.Type = wdWrapTopBottom
.Anchor.Cut
End With
Rng.Paste
End If
End With
End If
End With
End With
Next
End With
End Sub

[smallken]

Hi Carlito,
With Word VBA you can write some great routines for editing and cleaning up document content but when it comes to the final layout, VBA can be of help but a lot of manual input is still necessary.

For example, your idea of adjusting picture sizes raises some other issues. What about captions that can finish up on a different page. You could write code to assume that the paragraph after (or before) the picture is a caption and must be on the same page as the picture but some pictures may have no caption and others may have an extra paragraph mark before the caption. You could give captions a special style for example “Picture Caption” that VBA would use to identify captions but this requires discipline in entering captions.

Another way of fitting pictures into a page is to move text paragraphs either side of the picture by moving the anchor. This could be automated in VBA but it may not always be desirable. For example if text in a paragraph refers to “the picture below”, then moving the picture to above the paragraph requires changing the text.

A suggestion is to write macros to move a picture (and caption) up or down by one paragraph. To use, select the picture and enter a hot key to run the macro that moves the picture in the desired direction.

Documents never seem to be complete. Even if you think that you have the final draft, often last minute changes need to be made and these invariably upset the layout and cascade changes through following pages. Suddenly, a picture that was re-sized to fit a page now needs to be re-sized again or returned to its original size – or moved to after the original paragraph. You hope that you have saved a “before layout changes” copy of the document so that you can see the original picture size and where the picture was originally placed.

[macropod]

Slight correction to the code I posted: delete '.Select ' - it's unnecessary and is merely a left-over from testing.

[carlito_1985]

Great thanks heaps for that macropod!!! I haven't tested it yet but I'll definately have a play around a bit later on.

Thank you both for your great answers. I really appreciate the time and effort you have gone to in assisting a Word VBA noob.

[smallken]

There is a problem with macropod's elegant code. Because layout changes flow through to following pages, it is important that changes be made in sequence from the start to the end of the document.

However, the order of the shapes collection is the order that the shapes were inserted in the document which may not necessarily be sequential through the document. Therefore:
For Each Shp in .Shapes
may not give the correct sequence.

I am scratching my head to work out how the get the correct sequence. Probably by using successive Find.

Also, the default for inserting a picture is inline whereas the method requires the pictures to be floating.

The following code will convert all inline shapes in the document to floating:
Dim shpI as InlineShape
For Each shpI In ActiveDocument.InlineShapes
shpI.ConvertToShape
Next shpI

[macropod]

Hi smallken,

I'm not sure you're right about the 'For Each Shp In .Shapes' not working sequentially through the document but, if you are, that can be handled by:
Sub PicResize()
Dim Shp As Shape, Rng As Range, ShpPos As Single, ShpHt As Single, SpcHt As Single, i As Long
With ActiveDocument
For i = 1 To .Shapes.Count
Set Shp = .Shapes(i)
With Shp
or, more efficiently:
Sub PicResize()
Dim i As Long, Rng As Range, ShpPos As Single, ShpHt As Single, SpcHt As Single
With ActiveDocument
For i = 1 To .Shapes.Count
With .Shapes(i)
along with changing the second 'With Shp' to 'With .Shapes(i)'

As you say, though, pictures may be inserted as InlineShapes. These could be iterated through in similar manner. However, given the possibility that there may be a mix of both kinds, coding to handle both intelligently becomes an 'interesting' challenge...

[smallken]

Hi macropod

The tests that I carried out showed that .Shapes(i) gives the same out of sequence results as For Each shp In .Shapes

I had previously written a very useful set of applications to assist in editing and I am now writing an application to assist in finessing the layout of documents This will include routines to position shapes and tables. Our discussion has been useful and has given me some ideas that I will follow up.

Regards

[macropod]

Hi smallken,

The tests that I carried out showed that .Shapes(i) gives the same out of sequence results as For Each shp In .Shapes
In that case, the process will require laboriously going through every page, finding out how much space there is at the bottom (this part's easy), then finding out which shape/inlineshape on the next page is positioned highest on the page, comparing that to the highest-positioned text on the page, and working out whether to transfer it to the current page. Presumably, any captions asscoiated with the shapes/inlineshapes need to be considered as well. In anything other than a document for which all other editing has been finalised, this whole process is going to be problematic.

[smallken]

Hi


Final layout is always tedious and time consuming, especially for large documents. But because every document is different, it would be very difficult to completely automate the process.

To adjust shapes to fit the page might require resizing, moving surrounding text either side of the shape or in many cases moving the shape or its caption up or down by just a few points. There are other tricks such as trimming page borders to fit in a few extra words. I find the best way is to have an armory of macros that carry out different actions then manually go through the document from start to finish making changes.

I use a non-modal form that floats over the screen. The form contains settings for the macros, for example the percentage size reduction or the number of points for each move. Eyeballing the page will give an idea of what adjustments are necessary, then it is a matter of clicking on the shape to select it and using either a hot key or a button on the form to run the appropriate routine. If the layout is still not right then a couple of clicks will reverse the action and try something else. As new ideas for macros come up it is easy to add code and a button on the form to run the macro.


I have tried adding macros to the ribbon in W2010 but I prefer the floating form. Besides, it can be used in earlier versions of Word.

[Frosty]

Just to add to the discussion, I think smallken and macropod are both correct, it just depends on when you ask the question.

The shapes collection is added to sequentially as you insert shapes into the document.

However, when you re-open a document, the shapes collection is created on the fly based on the z-order of the shape (from "lowest" to "highest").

So if you have changed the z-order of a shape object (sent the last shape created "to the back", as it were), when you re-open the document, that shape sent to the back will be earlier in the shapes collection.

[Frosty]

Actually, further testing (because I was curious) shows that the index number seems to correspond with the zorder as it's changed.

I suspect you could figure out the true "order" (at least, regarding pages) by checking the range of the paragraph a shape was anchored to (since they are always on a particular page), just by cycling through all the shapes, and then adding a corresponding start number to it... something along the lines of...

Sub ShapesLinearOrderProofOfConcept()
Dim shp As Shape
Dim aryShapes() As String
Dim x As Integer

For Each shp In ActiveDocument.Shapes
Debug.Print shp.Name
ReDim Preserve aryShapes(2, x)
aryShapes(0, x) = shp.Name
aryShapes(1, x) = shp.ZOrderPosition
aryShapes(2, x) = shp.Anchor.Paragraphs(1).Range.Start
x = x + 1
Next
'the WordBasic.SortArray parameters for 2-dimensional arrays is tricky
'the arguments are: WordBasic.SortArray ArrayName[$]() [, Order] [, From] [, To] [, SortType] [, SortKey]
'so explaining each argument:
'aryShapes = the array we're sorting
'0 = sort order, a-z... 1 or -1 gives us a z-a sort
'0 = start sorting at this number, 1 would give us a default of our first one
'Ubound(aryShapes,2) = the number of elements (it's okay to have it be a little higher)
'1 = sorting by columns rather than the default rows (which would be 0)
'0 = the array element to sort by (our description) rather than the template name
'our sort array can sometimes fail if we only have one item in list, ignore if it does
WordBasic.SortArray aryShapes, 0, 0, UBound(aryShapes, 2), 1, 2

'now that it's sorted based on the .Start of the range of the first paragraph of the anchor
'iterate through
For x = 0 To UBound(aryShapes, 2)
Set shp = ActiveDocument.Shapes(aryShapes(0, x))
Debug.Print shp.Name
Next
End Sub


If you wanted to further the concept, you could add in the .Top, I suppose so that you didn't reduce a shape at the bottom of a page (but anchored to a paragraph at the top of a page)... but you can ultimately break any of this functionality, and it may be better to think of a more linear way to use graphics, if dealing with them in a linear fashion is really important (like having the graphic inside a frame, or a table cell, or having it be an inline shape).