Automating pasting of EMF in Word and adjust scaling

When I am writing with Word instead of LaTeX I prepare figures on Powerpoint so I have them ready for presentations. Unfortunately the default Paste command selects a bitmap image that most of the time is blurry so I prefer the Enhanced Metafile (EMF) format that is vectorial. This requires few more clicks.

Also when I have already an image and I want to replace with a new one I loose the scaling.

The following VBA macro allows to paste in EMF and to keep the with of the original image, while height is obtained by keeping the ratio. Unfortunately it is not possible to replace the image content withour removing the shape, so it has to be destroyed and replaced.

Sub MyPasteEMF()
    Dim x As InlineShape
    sw = 0
    sh = 0
    If Selection.InlineShapes.Count > 0 Then
        Set x = Selection.InlineShapes(1)
        sw = x.Width
        sh = x.Height
        x.Delete
    End If
    Dim r As Range
    Set r = Selection.Range
    w = 0
    On Error Resume Next
    r.PasteSpecial Placement:=wdInLine, DataType:=wdPasteEnhancedMetafile
    w = Err.Number
    On Error GoTo 0
    If w = 5342 Then
        w = 0
        On Error Resume Next
        r.PasteSpecial Placement:=wdInLine, DataType:=wdPasteDeviceIndependentBitmap
        On Error GoTo 0
        If w > 0 Then
        r.PasteSpecial Placement:=wdInLine, DataType:=wdPasteDefault
        End If
    End If
    Set r = r.Previous
    Set w = r.InlineShapes(1)
    If sw > 0 Then
        f = w.Height / w.Width
        w.Width = sw
        w.Height = f * sw
    Else
        w.ScaleHeight = 50
        w.ScaleWidth = 50
    End If
End Sub

Updated: 14/11/2011 with support for pasting objects that have no EMF content