Word 2010: Копирование текста с рисунками в другую программу

Sub ScalePic()
Dim inshp As InlineShape
    For Each inshp In ActiveDocument.InlineShapes
        Select Case inshp.Type
            Case 3, 4, 12, 13
            If inshp.ScaleWidth <> 100 Then
                inshp.ScaleWidth = 100
            End If
            If inshp.ScaleHeight <> 100 Then
                inshp.ScaleHeight = 100
            End If
        End Select
    Next inshp
End Sub

Sub ScalePic()
Dim inshp As InlineShape
    For Each inshp In ActiveDocument.InlineShapes
        Select Case inshp.Type
            Case 3, 4, 12, 13
            If inshp.ScaleWidth <> 100 Then
                inshp.Select
                    inshp.ScaleWidth = 100
                    inshp.ScaleHeight = 100
                    If inshp.Width > ColumnWidth(inshp) Then
                        inshp.Width = ColumnWidth(inshp)
                        inshp.ScaleHeight = inshp.ScaleWidth
                    End If
            End If
        End Select
    Next inshp
End Sub

Public Function ColumnWidth(inshp As InlineShape) As Single
Dim l As Single, r As Single, p As Single
    p = inshp.Range.PageSetup.PageWidth
    l = inshp.Range.PageSetup.LeftMargin
    r = inshp.Range.PageSetup.RightMargin
        ColumnWidth = p - (l + r)
End Function