如何使用VBA使用Excel中的文本數據創建新的PowerPoint幻燈片？

Question

我嘗試僅修改現有論壇中的代碼，但它是為現有的PowerPoint設計的，我想使用已經填充的excel信息創建一個新的PowerPoint。 您能告訴我代碼中哪里出問題了嗎？

Sub MarinePowerpoint()

Dim ws As Worksheet, wsB As Worksheet
Set ws = Worksheets("Overview")
Set wsB = Worksheets("Billing Rates")

Dim trueCount As Integer
Dim i As Integer
Dim Cst, Hrs


For i = 1 To 11

If ws.Range(Chr(65 + i) & "36").Value = "True" Then
    trueCount = trueCount + 1
    Cst = Cst + wsB.Range(Chr(66 + i) & "33").Value
    Hrs = Hrs + wsB.Range(Chr(66 + i) & "25").Value
    Scope = Scope + wsB.Range(Chr(66 + i) & "150").Value
End If

Next i

If trueCount > 0 Then
trueCount = trueCount + 1
    Cst = Cst + wsB.Range(Chr(66 + i) & "33").Value
    Hrs = Hrs + wsB.Range(Chr(66 + i) & "25").Value
    Scope = Scope + wsB.Range(Chr(66 + i) & "150").Value
Data = "Cost: " & Cst _
& vbNewLine & "Hours: " & Hrs _
& vbNewLine & "Scope: " & Scope

'MsgBox Data
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slides
Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Add
PPPres.Range.Text = Data

End If

If trueCount = 0 Then
     MsgBox "Please select engagement components."
End If

End Sub

Answer 1

這是一些添加文本形狀的示例代碼：

Sub Example()

    Dim oSh As Shape

    ' On slide 1 of the currently active presentation:
    With ActivePresentation.Slides(1)

        ' Add a rectangle at 100/100 left/top, 200/200 high and wide:
        ' Units are in points, 72 points = 1 inch
        Set oSh = .Shapes.AddShape(msoShapeRectangle, 100, 100, 200, 200)

        With oSh
            ' Ooo, let's make it bright red
            .Fill.ForeColor.RGB = RGB(255, 0, 0)
            ' and some text:
            With .TextFrame.TextRange
                .Text = "Oooo, my face is red!"

                ' Format the text a bit:
                With .Font
                    .Name = "Arial"
                    .Color.RGB = RGB(255, 255, 255)
                    .Size = 36  ' points
                End With    ' Font

            End With    ' Textrange
        End With    ' Shape

    End With

End Sub