Solved

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

Posted on 2010-11-19
5
540 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction Authors who set out to write any sort of lengthy piece for online submission—be it a long question or comment on a technical form, an article, or a substantial blog entry—often find it useful to work up a draft in an editor other t…
The Selection object is designed for user interaction. It has a Range property, so it can be used in most places that a Range object can. Recorded macros must use the Selection because they are simply copying what the user is doing. A Range prope…
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 and describes the main difference between both orientations in Microsoft Word. Viewers will understand when to use each orientation and how to get the most out of them.

910 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

21 Experts available now in Live!

Get 1:1 Help Now