macro to increase picture to 100%

[potternm via OfficeKB.com]

My group constantly copies vector art and pastes in as either Windows
Metafile or Enhanced Metafile, whichever is best for that case. But then we
need to make them 100%.

Is there any way to put the 100% in a macro? I've tried recording one, but
it always comes up with pixel measurements rather than percentages, so it
doesn't work for others. I have a macro (copied) to place inline with text as
Enhanced Metafile but nothing about changing the size.

Sub PasteAsMetafile()
Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
'Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:
=wdInLine
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InlineShapes(1).LockAspectRatio = msoTrue
End Sub

Wish I could write a macro, but have no experience. thanks for any help you
can provide.

Potternm

 

[Shauna Kelly]

Hi potternm

Something like this should do it. This acts on both inline shapes and
floating shapes.

Sub MakeShape100Percent()

Dim oILS As Word.InlineShape
Dim oShape As Word.Shape

On Error Resume Next
Set oILS = Selection.InlineShapes(1)
Set oShape = Selection.ShapeRange(1)

On Error GoTo 0
If Not oILS Is Nothing Then
With oILS
.ScaleWidth = 100
.ScaleHeight = 100
End With
ElseIf Not oShape Is Nothing Then
With oShape
.ScaleHeight Factor:=1, RelativeToOriginalSize:=True
.ScaleWidth Factor:=1, RelativeToOriginalSize:=True
End With
Else
MsgBox "Please click on an image or object and try again"
End If

End Sub


Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

 

[potternm via OfficeKB.com]

Thanks a lot. It works great. But we only work with inline, because
everything has to have a caption and we use frames if we want to wrap text
around it. Is there anyway I can make both macros one? Or have the original
call on yours? I want to get down to one keystroke/mouseclick if I can since
I've got arthritis in my fingers.

Hi potternm

Something like this should do it. This acts on both inline shapes and
floating shapes.

Sub MakeShape100Percent()

Dim oILS As Word.InlineShape
Dim oShape As Word.Shape

On Error Resume Next
Set oILS = Selection.InlineShapes(1)
Set oShape = Selection.ShapeRange(1)

On Error GoTo 0
If Not oILS Is Nothing Then
With oILS
.ScaleWidth = 100
.ScaleHeight = 100
End With
ElseIf Not oShape Is Nothing Then
With oShape
.ScaleHeight Factor:=1, RelativeToOriginalSize:=True
.ScaleWidth Factor:=1, RelativeToOriginalSize:=True
End With
Else
MsgBox "Please click on an image or object and try again"
End If

End Sub

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

My group constantly copies vector art and pastes in as either Windows
Metafile or Enhanced Metafile, whichever is best for that case. But then

[quoted text clipped - 22 lines]

Potternm