atw: Re: "Getting to grips with VBA basics in 15 minutes".
- From: "Naomi Kramer" <nkr@xxxxxxxxx>
- To: austechwriter@xxxxxxxxxxxxx
- Date: Fri, 06 Aug 2004 15:28:58 +1000
Hrmmm... dunno Ilana. Try this instead -
Sub ASI_ResizeScreenshot()
' Resizes all graphics to fit into page width and height.
Dim ishape As InlineShape
Dim MaxHeight As Double
Dim MaxWidth As Double
Dim NewHeight As Double
Dim NewWidth As Double
Dim ScaleBy As Double
Dim count As Integer
MaxHeight = CentimetersToPoints(15)
MaxWidth = CentimetersToPoints(12)
ScaleBy = 1
count = 1
For Each ishape In ActiveDocument.InlineShapes
With ActiveDocument.InlineShapes(count)
.LockAspectRatio = msoTrue
.Reset
NewWidth = .Width
NewHeight = .Height
If NewWidth > MaxWidth Then NewWidth = MaxWidth
.Width = NewWidth
End With
count = count + 1
Next ishape
End Sub
Oh, and make sure you have plenty of memory available, Word
macros chew it up and swallow it.
That's it - my brain quits for the day! :)
- Naomi
> Thanks Craig and Noami for your help.
> I tried running the macro with your changes. Strange things macros.
> The first time it actually worked by the graphics came out way too
> small (about 3 cms wide and not 13 as I set it). The second time it
> fell over on the line .Width = NewWidth. Any ideas what could be
> wrong. Ilana ************************************************** To
> post a message to austechwriter, send the message to
> austechwriter@xxxxxxxxxxxxxx
>
> To subscribe to austechwriter, send a message to
> austechwriter-request@xxxxxxxxxxxxx with "subscribe" in the Subject
> field.
>
> To unsubscribe, send a message to austechwriter-request@xxxxxxxxxxxxx
> with "unsubscribe" in the Subject field.
>
> To search the austechwriter archives, go to
> www.freelists.org/archives/austechwriter
>
> To contact the list administrator, send a message to
> austechwriter-admins@xxxxxxxxxxxxx
> **************************************************
**************************************************
To post a message to austechwriter, send the message to
austechwriter@xxxxxxxxxxxxxx
To subscribe to austechwriter, send a message to
austechwriter-request@xxxxxxxxxxxxx with "subscribe" in the Subject field.
To unsubscribe, send a message to austechwriter-request@xxxxxxxxxxxxx with
"unsubscribe" in the Subject field.
To search the austechwriter archives, go to
www.freelists.org/archives/austechwriter
To contact the list administrator, send a message to
austechwriter-admins@xxxxxxxxxxxxx
**************************************************
Other related posts:
