'
' PasteImageCertainHeight Macro
intDesiredWidth = 250
intDesiredHeight = 380
Selection.Paste
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ScaleValue = 1 ' default no change.
'atk 17/7/2016 created from web
' I like to add this code to be called on ctrl shift v
If Selection.InlineShapes.Count <> 0 Then
' if there is an inline shape, we are pasting picture
If Selection.InlineShapes(1).Height > intDesiredHeight Then
ScaleValue = intDesiredHeight / Selection.InlineShapes(1).Height
intNewHeight = Selection.InlineShapes(1).Height * ScaleValue
intNewWidth = Selection.InlineShapes(1).Width * ScaleValue
End If ' check height
'confirm we are not too wide either
If intNewWidth > intDesiredWidth Then
ScaleValue = intDesiredWidth / intNewWidth
intNewHeight = Selection.InlineShapes(1).Height * ScaleValue
intNewWidth = Selection.InlineShapes(1).Width * ScaleValue
End If ' check width
'Modify the values by the ScaleValue
Selection.InlineShapes(1).Height = Selection.InlineShapes(1).Height * ScaleValue
Selection.InlineShapes(1).Width = Selection.InlineShapes(1).Width * ScaleValue
Else
' pasting text,
Selection.PasteSpecial DataType:=wdPasteText
End If ' ' count of shapes to determine if pasting picture or tex
End Sub ' PasteImageCertainHeight
Sub PasteSpecial()
' I assign this to shortcut key ctrl-alt-v
Selection.PasteSpecial DataType:=wdPasteText
End Sub
No comments:
Post a Comment