如何使用VBA从excel创建包含文本数据的新PowerPoint幻灯片?

时间:2016-03-17 21:29:50

标签: excel vba excel-vba export powerpoint

我尝试过修改现有论坛中的代码,但它是为现有的powerpoint设计的,我想创建一个新的powerpoint,其中已经填充了excel的信息。你能告诉我我的代码在哪里出错吗?

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

1 个答案:

答案 0 :(得分: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