パワポからパブリッシャーへ貼り付け VBAでPowerPointからCreateObject("Publisher.Application")

パワポからパブリッシャーへ貼り付けを実験したです。
CreateObject("Publisher.Application")
が使えたことにビックリしただけで、
動画作成中にVBAで作らなくて良いことに気が付き・・・
また、動画録画用のPCと作成用のPCが違ったため、
マクロのセキュリティ警告が出て、動画作成を失敗したり・・

一行で書くと、
実験を失敗した動画です。
失敗動画が１つでも、少しでも解決のヒントとなれば幸いです。
youtu.be
https://youtu.be/CyBPqVaktGQ
目次
00:00 0.やりたいこと。パワポからパブリッシャーへ貼り付け
00:55 1.PowerPoint から Publisher に Shapeをコピーしてみた
02:38 1.1 確認失敗を確認する
03:55 2.PowerPoint から Word に Shapeをコピーしてみた
06:14 2.1 手作業 PowerPoint から Word 経由でPublisher

0.やりたいこと。
パワポからパブリッシャーへ貼り付け

知恵袋の質問で、
detail.chiebukuro.yahoo.co.jp

＞パワーポイントで作成したデータをパブリッシャーへ貼り付ける方法があれば教えて欲しいです。
＞パワーポイントで作成されたチラシのデータがあるのですが、
＞そのスライドをCtrl+Aで全体をコピーし、それをパブリッシャーに
＞貼り付けると全体が1枚の画像として貼り付けされてしまいます。
＞貼り付け先のパブリッシャーでテキストボックスや画像の配置修正などを行いたいので、
＞何か対処法などありましたら教えていただけると幸いです。

実際に不具合を再現してみる。
形式を選択して貼り付けに図しか無いですね・・・

1.PowerPoint から Publisher に Shapeをコピーしてみた

Ctrl+Aで全体をコピー
が
できないなら、
何を思ったのか？VBAで個別にやれば・・・
と思い、コードを書いてみた。
Publisherの変数名、pbXXXXのサンプルですね。
初見素人っぽく、plになっているのは、我慢してください。

Sub pp現在のプレゼンスライドから新規Publisherにセットするテスト()

    'パブリッシャーを起動
    Dim plApp As Object   'Publisher.Application
    Set plApp = CreateObject("Publisher.Application")

    If plApp Is Nothing Then
        MsgBox "アプリ パブリッシャーが開けません"
        Exit Sub
    End If
    
    'Publisher.Application 先頭に空白ページを追加する。※ここに固定セット
    Dim objNewDOC As Object   'Document
    Set objNewDOC = plApp.NewDocument
    objNewDOC.ActiveWindow.Visible = True
    
    Dim objNewPage As Object   'Page
    Set objNewPage = plApp.ActiveDocument.Pages(1)  '固定の先頭ページ
    
    'データをセットする
    Dim nPAGE As Integer
    nPAGE = ActiveWindow.Selection.SlideRange.SlideIndex '現在選択しているページ
    
    Dim ppSlide As PowerPoint.Slide  'スライド
    Set ppSlide = ActivePresentation.Slides(nPAGE) '↑現在のページを変数に
    
    Dim ppShape As PowerPoint.Shape  'pp:シェイプ
    Dim plShape As Object   'パブリッシャーのシェイプ

    'テストで選択ページの.Shapesを探る
    Debug.Print "Id", "Name", "Type"
    For Each ppShape In ppSlide.Shapes  'スライド内のシェイプ達を一つ一つあさる
        Debug.Print ppShape.Id, ppShape.Name, ppShape.Type
        
        'ppShape.Select  'わかりやすいように該当オブジェクトを選択
        ppShape.Copy    'コピー クリップボードに入る？
        DoEvents
        
        objNewPage.Shapes.Paste  'パブリッシャーのページ1固定で貼り付け
        DoEvents
        Set plShape = objNewPage.Shapes(objNewPage.Shapes.Count)  '一番後ろを代入、いいのか？これ？
        plApp.Selection.Unselect  'pl側:選択の解除
        
        '貼り付けたシェイプの座標を移動
        '単純に左上 Top,Leftを代入。 比率で調整とかはしていない
        '※厳密にはレイアウト全体違うので、それっぽく？
        plShape.Top = ppShape.Top
        plShape.Left = ppShape.Left
       
        'Stop
    Next

    MsgBox "終了"
 
End Sub

1.1 確認失敗を確認する

よし、個別に図形が貼り付きましたね。
図形のテキストを変更したくて、ダブルクリック。
あれ？図形ですね・・・

※壮大な勘違い、
Ctrl+Aで全体をコピー
だから、図しか貼り付けられない、と、思ってたら、
PowerPointのオブジェクト、個別でも、図の貼り付けしかなかった・・・

しくじりました・・・
失敗動画として、残しておきます。

CreateObject("Publisher.Application")

が、使えるんだぁ・・・
くらいの感覚で見てもらえるとありがたいです。

2.PowerPoint から Word に Shapeをコピーしてみた

失敗動画、しかたないか。
Set plApp = CreateObject("Publisher.Application")
Set objNweDOC = plApp.NewDocument
って、
Documentだから、Wordに似ているね。

pp → Word なら、
使用している人が多いし、
パワポのテキストボックスや図形を貼り付けた記憶あるしなぁ。
対応しているかも？

Wordに貼り付けてから、※形式を選択して貼り付けでOfficeグラフィックがある
ダブルクリックすると、
図ではなく、オブジェクトとして貼りついた？

2.1 手作業 PowerPoint から Word 経由でPublisher

PowerPoint から Word 経由でPublisher

あっ。
VBA使わなくて、いいのか・・・

2.1.1 PowerPoint Ctrl+A で全選択, Ctrl+C でコピー
2.1.2 Word Ctrl + Vで貼り付け、Ctrl+C で再コピー
2.1.3 Publisher Ctrl + Vで貼り付け

で、貼りつくが、少しイメージが・・・
ここまでなら、手作業でできそうです。
と、動画作成中に発見したり・・・

ここから、おまけ。

2.2 VBA PowerPoint から Word に Shapeをコピーしてみた

一回、Wordに貼り付けてから、再コピーするとできそうなので、
PowerPoint から Word に Shapeをコピーしてみた
(Publisher.ApplicationとWord.Application
Documentsで似てたけど、微妙に違っていて、デバッグで止まりまくったのはナイショデス)

Sub pp現在のプレゼンスライドからWordにセットするテスト0527()

    '起動 Word
    Dim wdApp As Object   'Word.Application
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True

    '先頭に空白ページを追加する。※ここに固定セット
    Dim objNewDOC As Object   'Document
    Set objNewDOC = wdApp.Documents.Add
    wdApp.Selection.PageSetup.Orientation = 1   '向きを横にする 1:wdOrientLandscape
    
    'データをセットする
    Dim nPAGE As Integer
    nPAGE = ActiveWindow.Selection.SlideRange.SlideIndex '現在選択しているページ
    
    Dim ppSlide As PowerPoint.Slide  'スライド
    Set ppSlide = ActivePresentation.Slides(nPAGE) '↑現在のページを変数に
    
    Dim ppShape As PowerPoint.Shape  'pp:シェイプ
    Dim wdShape As Object   'Wordのシェイプ

    'テストで選択ページの.Shapesを探る
    Debug.Print "Id", "Name", "Type"
    For Each ppShape In ppSlide.Shapes  'スライド内のシェイプ達を一つ一つあさる
        Debug.Print ppShape.Id, ppShape.Name, ppShape.Type
        
        'ppShape.Select  'わかりやすいように該当オブジェクトを選択
        ppShape.Copy    'コピー クリップボードに入る？
        DoEvents
        
        wdApp.Selection.PasteSpecial  'Wordに貼付け
        DoEvents
        Set wdShape = objNewDOC.Shapes(objNewDOC.Shapes.Count)  '一番後ろを代入、いいのか？これ？
        
        '貼り付けたシェイプの座標を移動
        '単純に左上 Top,Leftを代入。 比率で調整とかはしていない
        '※厳密にはレイアウト全体違うので、それっぽく？
        wdShape.Top = ppShape.Top
        wdShape.Left = ppShape.Left
       
        'Stop
    Next

    MsgBox "終了"
 
End Sub