0

私が達成しようとしているのは、VBA を介して Excel でデータ、チャート、コメントを使用して自動 PowerPointPres を作成することです。

私が失敗したことが2つあります：

  1. PPP では、1 ページに 1 つのチャートではなく、1 つのページに 4 つのチャートを配置する必要があります。
  2. ソースのフォーマットを維持し、チャートを画像として貼り付けないようにする必要があります。

誰か修正を手伝ってくれませんか？

心から感謝する！

    Sub CreatePowerPoint()

 'Add a reference to the Microsoft PowerPoint Library by:

    '1. Go to Tools in the VBA menu    
    '2. Click on Reference    
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

    'First we declare the variables we will be using

        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject

     'Look for existing instance
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0

    'Let's create a new PowerPoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Make a presentation in PowerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Add
        End If

    'Show the PowerPoint
        newPowerPoint.Visible = True

    'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
        For Each cht In ActiveSheet.ChartObjects

        'Add a new slide where we will paste the chart
            newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
            newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
            Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

        'Copy the chart and paste it into the PowerPoint as a Metafile Picture
            cht.Select
            ActiveChart.ChartArea.Copy
            activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

        'Set the title of the slide the same as the title of the chart
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

        'Adjust the positioning of the Chart on Powerpoint Slide
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

            activeSlide.Shapes(2).Width = 200
            activeSlide.Shapes(2).Left = 505

        'If the chart is the "US" consumption chart, then enter the appropriate comments
            If InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "US") Then
                activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine
                activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine)
        'Else if the chart is the "Renewable" consumption chart, then enter the appropriate comments
            ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Renewable") Then
                activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine
                activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine)
                activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine)
            End If

        'Now let's change the font size of the callouts box
            activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 16

        Next

    AppActivate ("Microsoft PowerPoint")
    Set activeSlide = Nothing
    Set newPowerPoint = Nothing

End Sub
4

1 に答える 1

1

スライド作成部分をループの外に移動し、最初の部分を次のように変更することで、それを実現できると思います。

    'Add a new slide where we will paste the chart
    newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
    newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
    Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    For Each cht In ActiveSheet.ChartObjects

        Dim i As Integer
        i = i + 1

    'Copy the chart and paste it
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select

    'Set the title of the slide the same as the title of the chart
    If cht.Chart.HasTitle = True Then
        activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    End If

    'Adjust the positioning of the Chart on Powerpoint Slide
    If i = 1 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 5
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 100

        ElseIf i = 2 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 350
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 100

        ElseIf i = 3 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 5
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 325

        Else
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 350
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 325
    End If

その後、おそらくいくつかの調整を行う必要があります。

于 2015-02-17T16:21:50.390 に答える