Macroを使ってChartのすべてのデータをPPTにコピーしたい

[Anonymous]

Hi Experts

VB Scriptを組んでQVからPPTへオブジェクトをコピーするにあたって、

スクロールバーのついたChartは、画面上に見えている部分しかコピーが出来ません。

表のすべてのデータをコピーして貼り付けたいのですが、どのようなScriptを書けば良いのか分かりません。

ご教示いただけないでしょうか？

Textでコピーすると、全部のデータは取得できますが、表は崩れてしまいます。

Scriptは以下です。

赤字の部分のコードだと、画面に見えているタブの部分しかコピーできません。

よろしくお願い致します。

Sub ExportPPT

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Add

    For i = 0 To ActiveDocument.NoOfSheets - 3
        Set MySheet = ActiveDocument.GetSheet(i)

        Set PPSlide = objPresentation.Slides.Add(1,12)
        ActiveDocument.ActiveSheet.CopyBitmapToClipboard

ActiveDocument.GetSheetObject("CH01").CopyBitmapToClipboard 

objPPT.Visible = True

        PPSlide.Shapes.Paste()
                   
    Next

Set PPSlide = Nothing
Set PPPres = Nothing

End sub

[nobukitakahashi]

以下のコードでいかがでしょうか。MyArrayにすべてのすべてのオブジェクトIDを指定しておく必要がありますが。

Sub ExportPPT()

  Dim MyArray(1)

  MyArray(0) = "CH01"

  MyArray(1) = "CH02"

    Set PPApp = CreateObject("PowerPoint.Application")

    PPApp.Visible = True

    Set PPPres = PPApp.Presentations.Add

    For Each Item In MyArray

        Set PPSlide = PPPres.Slides.Add(1, 11) 'タイトルのみ

        ActiveDocument.GetSheetObject(Item).CopyBitmapToClipboard

        PPSlide.Shapes.Paste

    Next

    Set PPSlide = Nothing

    Set PPPres = Nothing

    Set PPApp = Nothing

End Sub

[Anonymous]

チャートのX-軸スクロールバーの表示で10に制限しているグラフで10を超えるデータが表示されている場合を想定して、一時的にX-軸スクロールバーの表示をオフにして、グラフの幅を調整しグラフイメージをクリップボードにコピーするようにしてみましたが質問の趣旨に合ってますかね？

Sub ExportPPT()
Dim objPPT
Dim objPresentation
Dim PPSlide

    Dim oCh
    Dim oRect
    Dim oProp
    Const ciViewCnt = 10
    Dim dOldChWidth
    Dim bChgProp

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Add

Set PPSlide = objPresentation.Slides.Add(1, 11) 'タイトルのみ
    Set oCh = ActiveDocument.GetSheetObject("CH01")
    If oCh.GetRowCount >= ciViewCnt Then

        'チャートの幅を取得し、データ数に見合った幅に変更
        Set oRect = oCh.GetRect()
        dOldChWidth = oRect.Width
        oRect.Width = dOldChWidth * oCh.GetRowCount / ciViewCnt
        oCh.SetRect oRect
        'X-軸スクロールバーの表示が有効なら無効に変更
        bChgProp = False
        Set oProp = oCh.GetProperties()
        If oProp.ChartProperties.XAxisScroll Then
            oProp.ChartProperties.XAxisScroll = False
            oCh.SetProperties oProp
            bChgProp = True
        End If
       
        oCh.CopyBitmapToClipboard

        'X-軸スクロールバーの表示を無効に変更したら有効に戻す
        If bChgProp = True Then
            oProp.ChartProperties.XAxisScroll = True
            oCh.SetProperties oProp
        End If

        'チャートの幅を元に戻す
        oRect.Width = dOldChWidth
        oCh.SetRect oRect
    Else
        oCh.CopyBitmapToClipboard
    End If

    PPSlide.Shapes.Paste()

Set PPSlide = Nothing
Set PPPres = Nothing

End sub