埋め込み画像をExcelからWordに保存/コピーする方法

私が持っているもの:
Excelファイルで、列内(実際には自由形式ですが列内に収まるように配置されています)をクリックすると式= EMBED( “Paint.Picture”、 “”)を示す要素が埋め込まれています。 Excelシートを見ると、画像自体は表示されず、画像を表すアイコンのみが表示されます。

私が欲しいもの:
埋め込まれた画像(アイコンではありません)が新しいWord文書にコピーされました。

私がこれまでに持っているコード:

'Image Objects
Dim myObjs As Shapes
Dim myObj As Shape
Set myObjs = ActiveSheet.Shapes

'Traversing objects
Dim row As Integer
Dim myRange As Range
Dim myRange2 As Range
Dim isAddressMatch As Boolean

'Word Document Objects
Dim wordApp As New Word.Application
Dim myWord As Word.Document


'Prepare word for output
Set myWord = wordApp.Documents.Add
wordApp.Visible = True

'Initalize traversing objectts
Set myRange = Sheets("myWorksheet").Range("Q5")
Set myRange2 = Sheets("myWorksheet").Range("E5")
row = 0

'Loop through range values in the desired column
While (myRange2.Offset(row).Value <> "")
    'Loop through all shape objects until address match is found.
    For Each myObj In myObjs

        On Error Resume Next
        isAddressMatch = (myObj.TopLeftCell.Address = myRange.Offset(row).Address)
        If Err.Number <> 0 Then
            isAddressMatch = False
            On Error GoTo 0
        End If

        'When match is found copy the bmp picture from Excel to Word
        If (isAddressMatch) Then
            myObj.Select
            ''''''''This copies the excel default picture,'''''''''''''''
            ''''''''not the picture that is embeded.'''''''''''''''''''''
            myObj.CopyPicture 'What is the correct way to copy myObj

            myWord.Range.Paste
            'Rest of the code not yet implement

        End If
    Next
    row = row + 1
Wend

コードを実行するとどうなりますか。
私のコードは、列の境界内にあるすべての「図形」を通過し、そのオブジェクトの画像をコピーします。しかし、単語に貼り付けると、文字通りリンク画像(アイコン)のコピーが作成され、基礎となる埋め込み画像は作成されません。

私がこれまでに見つけたもの:
これは埋め込みオブジェクトの作成方法を示していますが、コピー方法は示していません。

ベストアンサー
アップデート:よりシンプルなソリューション

jspekによるコメントで指定されているように、画像は実際にはOLEObjectのCopyメソッドを使ってコピーすることができます。

Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)

'Copy the OLE object representing a picture.
obj.Copy
'Paste the picture in Word.
myWord.Range.Paste

古い解決策

クリップボードとSendKeysの両方を含む、最適ではないソリューションを見つけました – this linkに触発されています。OLEObjectのプロパティを抽出する方法を探ることによって、もっとエレガントにこれを実行できると確信しています。これらを抽出することは、この執筆時点での私の専門知識の範囲を超えています:-)

それはOLEObjectを中心に展開します。このコードはあなたの写真のOLE object’s host application(この場合はPaint)を実行し、その写真をコピーするためのキーを送り、最後にそれをWordに貼り付けます。

'Get the OLE object matching the shape name.
Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)

'Activate the OLE host application.
obj.Activate
'Send CTRL+A to select the picture in Paint and CTRL+C to copy it.
Application.SendKeys "^a"
Application.SendKeys "^c"
'Paste the picture in Word.
myWord.Range.Paste

転載記事の出典を記入してください: 埋め込み画像をExcelからWordに保存/コピーする方法 - コードログ