Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
Excelの表からPowerpointの特定スライドへの表の貼り付け(元の書式を保持)
投稿日時: 19/08/01 17:44:42
投稿者: dendentom

Excelの特定のワークシート上の表1つをコピーし、PowerPointの特定スライドへ張り付けようと思っています。
ただPaste Specialとかだと表の内容を更新しようとするともとのExcelが開いてしまうため、ちょっと特殊な方法ではありますがコーディングしました。
 
 

function report()

    'PowerPointオブジェクト
        Dim pp_app As PowerPoint.Application
        Set pp_app = New PowerPoint.Application
        pp_app.Visible = True

    'プレゼンテーション
        Dim report_file_name As String
            report_file_name = ticket_data_folder & "Weekly_Report_20190801.pptx"
                                  ※ticket_data_folderはファイルまでのパスです。D:\***\です。

        Set pp_prs = pp_app.Presentations.Open(report_file_name )

(ページ1〜ページ7のコードは中略。)

            '#Page8
                wb_report.Worksheets("Calender").Range("A1").CurrentRegion.Copy
               ※wb_reportブック、worksheets名に相違ないこと、指定範囲がコピーされていることはデバックモードで確認済です。
                
                With pp_prs.Slides(8)                    
                    With .Shapes
                        pp_app.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting")
                        pp_app.CommandBars.ReleaseFocus
                        
                        Do While shape_count = pp_prs.Slides(8).Shapes.Count
                            DoEvents
                        Loop
                        
                        With .Item(.Count)
                            .Name = "Calender"
                            .LockAspectRatio = False
                            .Top = 4.3 * 72 / 2.54
                            .Left = 0.5 * 72 / 2.54
                            .Width = 33 * 72 / 2.54
                            .Height = 14 * 72 / 2.54
                        End With
                    End With
                End With

(以降は最終ページまでのコードしか書いてないので略します。

end function

 
 
このコードではエラーは発生しないのですが、コピーした表の貼り付けができず、
ページ8にある最後のシェイプの図形サイズが調整されてしまいます。
デバッグモードで実行すると確実に表が張り付けられるのですが、通常モードで実行すると貼り付けができません。
以下のコードのあとにDoWhile loop文を入れて待ち時間を作ったのですができませんでした。
pp_app.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting")
 
 
参考にしたページ
https://ateitexe.com/powerpoint-paste-datatype/
 
デバッグモードで実行すると表が張り付けられ、サイズ調整されるのでコントロールID自体は間違っていないと思っています。
待ち時間が足りてないんでしょうか?

回答
投稿日時: 19/08/01 20:56:53
投稿者: simple

投稿にあたって、不要な箇所を書く必要はありませんが、
少なくとも回答者がそのまま動作でき、
現象が再現できるようなコードを提示してください。
そのように務めることによって、思わぬミスに自分で気づくこともあります。
 
・使用している変数は、必ず宣言して下さい。
・使っている変数は、必ず適切な値等をセットして下さい。
  (例えば、shape_countとは何ですか?)
・きちんとインデントを付けて下さい。

回答
投稿日時: 19/08/01 21:49:09
投稿者: んなっと

ExecuteMsoを使う場合、
View.GotoSlide 8 とか Slides(8).Select がなければ
Slides(8)には貼り付けられませんよ。
 
今のコードにこだわるなら、
 
  With pp_prs.Slides(8)
    .Select
    With .Shapes
      shape_count = .Count
      pp_app.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
      Do While shape_count = .Count
        DoEvents
      Loop
      With .Item(.Count)
        .Name = "Calender"
        .LockAspectRatio = False
        .Top = 4.3 * 72 / 2.54
        .Left = 0.5 * 72 / 2.54
        .Width = 33 * 72 / 2.54
        .Height = 14 * 72 / 2.54
      End With
    End With
  End With
 
普通は以下のようなコードです。
 
  With pp_prs.Windows(1)
    .ViewType = ppViewNormal
    .View.GotoSlide 8
    With .View.Slide.Shapes.PasteSpecial(ppPasteHTML)
      .Name = "Calender"
      .LockAspectRatio = False
      .Top = 4.3 * 72 / 2.54
      .Left = 0.5 * 72 / 2.54
      .Width = 33 * 72 / 2.54
      .Height = 14 * 72 / 2.54
    End With
  End With

投稿日時: 19/08/02 10:42:16
投稿者: dendentom

@んなっと
 
大変ありがとうございます。
おかげ様で解決いたしました。
 
pastespecialは知っているんですが、「元の書式を保持して貼り付け」がしたいと思っていたため、
んなっと様にご教示いただいたコードと私のコードを組み合わせました。