Solved

How to create a Macro in MS Word 2003 to resize all images in document

Posted on 2010-11-19
5
539 Views
Last Modified: 2012-05-10
I run a merged fields document every week, this contains a picture on each page and there is 1 picture per page.  All of these pictures come through as different sizes.

I have previously asked people on EE to look at how we can re-code the document to pull through the images the correct size but due to the way the document was developed and how we run the merge this is not possible.

I was wondering as a workaround if something else could be done to resize all images simply rather than manually changing them all.

After a few google searches it appears that a Macro would resolve the problem, however, I have never created a Macro before.

I have found some sample code here:

http://en.allexperts.com/q/Microsoft-Word-1058/Word-resize-pictures.htm

But have no idea how to create a macro, add the code then run it.

Any help on this issue will be greatly appreciated.

Im have not added the document to this post as it contains personal customer data.  If this becomes necessary then i'll work through it and remove all the info.
0
Comment
Question by:auraorange
  • 3
  • 2
5 Comments
 
LVL 2

Author Comment

by:auraorange
ID: 34172581
If at all possible, I'd like to specify the size of the images in pixels
0
 
LVL 14

Accepted Solution

by:
leoahmad earned 500 total points
ID: 34172596

Sub ResizeAllImages()

' make all images (both inline and floating)

' 11 cm wide while preserving aspect ratio



Dim oShp As Shape

Dim oILShp As InlineShape



For Each oShp In ActiveDocument.Shapes

With oShp

.Height = AspectHt(.Width, .Height, _

CentimetersToPoints(11))

.Width = CentimetersToPoints(11)

End With

Next



For Each oILShp In ActiveDocument.InlineShapes

With oILShp

.Height = AspectHt(.Width, .Height, _

CentimetersToPoints(11))

.Width = CentimetersToPoints(11)

End With

Next

End Sub



Private Function AspectHt( _

origWd As Long, origHt As Long, _

newWd As Long) As Long

If origWd <> 0 Then

AspectHt = (CSng(origHt) / CSng(origWd)) * newWd

Else

AspectHt = 0

End If

End Function

Open in new window

0
 
LVL 2

Author Comment

by:auraorange
ID: 34172976
Thank you the code is perfect!

I've changed the size perameters and that worked fine.

I still have a problem where the document also contains frames and text boxes and these have also resized but Ill have to probably post a new question for that
0
 
LVL 14

Expert Comment

by:leoahmad
ID: 34173023
Better you do that as it is against the policy of EE to ask multiple questions in one thread.

LeoAhmad
0
 
LVL 2

Author Closing Comment

by:auraorange
ID: 34173173
Worked perfectly

Thank you once again
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

There is a feature provided by MS Word that lets you create an Table of Contents for your Word document automatically. To use this feature for other documents there are two steps involved,   1.  Prepare your document for a table of contents (he…
When creating Microsoft Word-based forms there may be a need to have a form field repeated throughout the whole document. For instance, with a company name, you may want this information repeated automatically throughout the document rather than man…
This video walks the viewer through the process of creating a watermark for their document, customizing it, and saving it for viewing/printing needs.
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now