Sunday, 17 July 2016

Microsoft Word Macro to paste images Sub PasteImageCertainHeight()

Sub PasteImageCertainHeightOrText()
'
' 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: