Group:  Microsoft Word ยป microsoft.public.word.docmanagement
Thread: Help. Recording a Macro to resize maintaining aspect ratio

Geek News

Help. Recording a Macro to resize maintaining aspect ratio
"Simon" <simonbradley[ at ]activia.co.uk> 12/11/2008 12:46:00 PM
Hi there,

I have a document with lots of images that are too big. I am trying to
resize them all to 11cm wide and maintain the aspect ratio for the height.
I recorded a basic macro but the height is equal to whatever measurement was
in there when I recorded.

Any way around this please!!!

Thanks

Simon


RE: Help. Recording a Macro to resize maintaining aspect ratio
Brian 12/11/2008 1:32:00 PM
This code was given to me in answer to my question on the same subject by
Stefan

Sub PictSize()
Dim HieghtSize As Integer
Dim oIshp As InlineShape
Dim oshp As Shape
HeightSize = InputBox("Enter height ", "Resize Picture", 11)
For Each oIshp In ActiveDocument.InlineShapes
With oIshp
.LockAspectRatio = msoTrue
'Here's the modified line of code:
.Height = CentimetersToPoints(HeightSize)
End With
Next oIshp
End Sub

Hope it helps

--
Brian McCaffery


"Simon" wrote:

[Quoted Text]
> Hi there,
>
> I have a document with lots of images that are too big. I am trying to
> resize them all to 11cm wide and maintain the aspect ratio for the height.
> I recorded a basic macro but the height is equal to whatever measurement was
> in there when I recorded.
>
> Any way around this please!!!
>
> Thanks
>
> Simon
>
>
>
RE: Help. Recording a Macro to resize maintaining aspect ratio
DeanH 12/11/2008 2:10:04 PM
Hello Simon and Brian.
Unfortuantely this macro is set for height and does not maintain ratio. I am
sure with minor tinkering this will work.
In the mean time I have the below macro which I got from someone on this
forum sometime ago (cannot remember for the moment) and this does work.

TIP: This macro will only change images that are InLineWithText and not
floating. If the images are floating (ie not set with the InLineWithText) the
you can
use the Select Multiple Objects (the icon is found on the Drawing Toolbar
under Customize).
Beware this may select objects you don't want to change, so tread carefully
- maybe work on a copy of the document.

If the Images are InLineWith then the following macro will change all in one
click.

Sub ResizePictureWidth()
' Macro to Resize ALL pictures in the document

Dim inshpPower As InlineShape
Dim sngOldWidth As Single
Const sngNewWidth As Single = 13.5
With ActiveDocument
If .InlineShapes.Count > 0 Then
For Each inshpPower In .InlineShapes
With inshpPower
sngOldWidth = .Width
.Width = CentimetersToPoints(sngNewWidth)
.Height = CentimetersToPoints(((.Height * sngNewWidth) /
sngOldWidth))
End With
Next
Else
MsgBox "There are no shapes in this document.", _
vbExclamation, "Cancelled"
End If
End With
End Sub

This macro is set for 13.5cm (my text margin width), so you may need to
change this for your needs.
See http://word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm for help with macros.
You don't say want Word version you are using, the above is mainly for 2003
and prior but will indicate were to go with 2007.
Hope this helps
DeanH



"Brian" wrote:

[Quoted Text]
> This code was given to me in answer to my question on the same subject by
> Stefan
>
> Sub PictSize()
> Dim HieghtSize As Integer
> Dim oIshp As InlineShape
> Dim oshp As Shape
> HeightSize = InputBox("Enter height ", "Resize Picture", 11)
> For Each oIshp In ActiveDocument.InlineShapes
> With oIshp
> .LockAspectRatio = msoTrue
> 'Here's the modified line of code:
> .Height = CentimetersToPoints(HeightSize)
> End With
> Next oIshp
> End Sub
>
> Hope it helps
>
> --
> Brian McCaffery
>
>
> "Simon" wrote:
>
> > Hi there,
> >
> > I have a document with lots of images that are too big. I am trying to
> > resize them all to 11cm wide and maintain the aspect ratio for the height.
> > I recorded a basic macro but the height is equal to whatever measurement was
> > in there when I recorded.
> >
> > Any way around this please!!!
> >
> > Thanks
> >
> > Simon
> >
> >
> >
Re: Help. Recording a Macro to resize maintaining aspect ratio
"Simon" <simonbradley[ at ]activia.co.uk> 12/11/2008 2:15:44 PM
Thank you both for your work... much appreciated.

"DeanH" <DeanH[ at ]discussions.microsoft.com> wrote in message
news:DF9592A9-41A5-4B26-958F-45E29BE9C51E[ at ]microsoft.com...
[Quoted Text]
> Hello Simon and Brian.
> Unfortuantely this macro is set for height and does not maintain ratio. I
> am
> sure with minor tinkering this will work.
> In the mean time I have the below macro which I got from someone on this
> forum sometime ago (cannot remember for the moment) and this does work.
>
> TIP: This macro will only change images that are InLineWithText and not
> floating. If the images are floating (ie not set with the InLineWithText)
> the
> you can
> use the Select Multiple Objects (the icon is found on the Drawing Toolbar
> under Customize).
> Beware this may select objects you don't want to change, so tread
> carefully
> - maybe work on a copy of the document.
>
> If the Images are InLineWith then the following macro will change all in
> one
> click.
>
> Sub ResizePictureWidth()
> ' Macro to Resize ALL pictures in the document
>
> Dim inshpPower As InlineShape
> Dim sngOldWidth As Single
> Const sngNewWidth As Single = 13.5
> With ActiveDocument
> If .InlineShapes.Count > 0 Then
> For Each inshpPower In .InlineShapes
> With inshpPower
> sngOldWidth = .Width
> .Width = CentimetersToPoints(sngNewWidth)
> .Height = CentimetersToPoints(((.Height * sngNewWidth)
> /
> sngOldWidth))
> End With
> Next
> Else
> MsgBox "There are no shapes in this document.", _
> vbExclamation, "Cancelled"
> End If
> End With
> End Sub
>
> This macro is set for 13.5cm (my text margin width), so you may need to
> change this for your needs.
> See http://word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm for help with
> macros.
> You don't say want Word version you are using, the above is mainly for
> 2003
> and prior but will indicate were to go with 2007.
> Hope this helps
> DeanH
>
>
>
> "Brian" wrote:
>
>> This code was given to me in answer to my question on the same subject by
>> Stefan
>>
>> Sub PictSize()
>> Dim HieghtSize As Integer
>> Dim oIshp As InlineShape
>> Dim oshp As Shape
>> HeightSize = InputBox("Enter height ", "Resize Picture", 11)
>> For Each oIshp In ActiveDocument.InlineShapes
>> With oIshp
>> .LockAspectRatio = msoTrue
>> 'Here's the modified line of code:
>> .Height = CentimetersToPoints(HeightSize)
>> End With
>> Next oIshp
>> End Sub
>>
>> Hope it helps
>>
>> --
>> Brian McCaffery
>>
>>
>> "Simon" wrote:
>>
>> > Hi there,
>> >
>> > I have a document with lots of images that are too big. I am trying to
>> > resize them all to 11cm wide and maintain the aspect ratio for the
>> > height.
>> > I recorded a basic macro but the height is equal to whatever
>> > measurement was
>> > in there when I recorded.
>> >
>> > Any way around this please!!!
>> >
>> > Thanks
>> >
>> > Simon
>> >
>> >
>> >


Re: Help. Recording a Macro to resize maintaining aspect ratio
"Simon" <simonbradley[ at ]activia.co.uk> 12/11/2008 2:25:05 PM
Just as a side note, will this run on all the pictures in the document or
selected images? I ask because some are smaller than 11cm wide and I don't
want to resize those.

Many many thanks

Simon





"Simon" <simonbradley[ at ]activia.co.uk> wrote in message
news:%23t7t2r5WJHA.1532[ at ]TK2MSFTNGP03.phx.gbl...
[Quoted Text]
> Thank you both for your work... much appreciated.
>
> "DeanH" <DeanH[ at ]discussions.microsoft.com> wrote in message
> news:DF9592A9-41A5-4B26-958F-45E29BE9C51E[ at ]microsoft.com...
>> Hello Simon and Brian.
>> Unfortuantely this macro is set for height and does not maintain ratio. I
>> am
>> sure with minor tinkering this will work.
>> In the mean time I have the below macro which I got from someone on this
>> forum sometime ago (cannot remember for the moment) and this does work.
>>
>> TIP: This macro will only change images that are InLineWithText and not
>> floating. If the images are floating (ie not set with the InLineWithText)
>> the
>> you can
>> use the Select Multiple Objects (the icon is found on the Drawing Toolbar
>> under Customize).
>> Beware this may select objects you don't want to change, so tread
>> carefully
>> - maybe work on a copy of the document.
>>
>> If the Images are InLineWith then the following macro will change all in
>> one
>> click.
>>
>> Sub ResizePictureWidth()
>> ' Macro to Resize ALL pictures in the document
>>
>> Dim inshpPower As InlineShape
>> Dim sngOldWidth As Single
>> Const sngNewWidth As Single = 13.5
>> With ActiveDocument
>> If .InlineShapes.Count > 0 Then
>> For Each inshpPower In .InlineShapes
>> With inshpPower
>> sngOldWidth = .Width
>> .Width = CentimetersToPoints(sngNewWidth)
>> .Height = CentimetersToPoints(((.Height * sngNewWidth)
>> /
>> sngOldWidth))
>> End With
>> Next
>> Else
>> MsgBox "There are no shapes in this document.", _
>> vbExclamation, "Cancelled"
>> End If
>> End With
>> End Sub
>>
>> This macro is set for 13.5cm (my text margin width), so you may need to
>> change this for your needs.
>> See http://word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm for help with
>> macros.
>> You don't say want Word version you are using, the above is mainly for
>> 2003
>> and prior but will indicate were to go with 2007.
>> Hope this helps
>> DeanH
>>
>>
>>
>> "Brian" wrote:
>>
>>> This code was given to me in answer to my question on the same subject
>>> by
>>> Stefan
>>>
>>> Sub PictSize()
>>> Dim HieghtSize As Integer
>>> Dim oIshp As InlineShape
>>> Dim oshp As Shape
>>> HeightSize = InputBox("Enter height ", "Resize Picture", 11)
>>> For Each oIshp In ActiveDocument.InlineShapes
>>> With oIshp
>>> .LockAspectRatio = msoTrue
>>> 'Here's the modified line of code:
>>> .Height = CentimetersToPoints(HeightSize)
>>> End With
>>> Next oIshp
>>> End Sub
>>>
>>> Hope it helps
>>>
>>> --
>>> Brian McCaffery
>>>
>>>
>>> "Simon" wrote:
>>>
>>> > Hi there,
>>> >
>>> > I have a document with lots of images that are too big. I am trying
>>> > to
>>> > resize them all to 11cm wide and maintain the aspect ratio for the
>>> > height.
>>> > I recorded a basic macro but the height is equal to whatever
>>> > measurement was
>>> > in there when I recorded.
>>> >
>>> > Any way around this please!!!
>>> >
>>> > Thanks
>>> >
>>> > Simon
>>> >
>>> >
>>> >
>
>


Home | Search | Terms | Imprint Contact
Newsgroups Reader - provided by WiredBox.Net