首页 文章

如何使用Excel VBA和userform编辑Excel中嵌入的PowerPoint演示文稿

提问于
浏览 次
2

我正在 Build 一个包含大量产品设计信息的数据库 . 我选择使用带有用户表单输入的Excel文件来设计细节，以便轻松地按细节过滤，然后选择指向包含带有照片和设计注释的嵌入式PowerPoint的相应页面的链接 . 目前，我有一个复制到新选项卡的模板，根据部件号的文本框输入重命名并创建指向目录中选项卡的链接 . 我可能要求太多，但我也希望用户窗体将文本添加到PowerPoint演示文稿中预先存在的文本框中 . 到目前为止，一切都运作良好 .

我发现了一个类似的问题并尝试了几次编码 .

Editing Embedded PowerPoint from Excel VBA

它有助于理解，但在这种情况下它对我不起作用：

Private Sub cmdAddSlide_Click()

    template = "Slide Template"

    'Hide the sheet
    ufrmAddSlide.Hide

    'Copy the template to create a new sheet.
    Sheets(template).Select
    Sheets(template).Copy After:=Sheets(Sheets.Count)

    'Make the sheet visible in case the template is hidden.
    ActiveSheet.Visible = xlSheetVisible

    'Rename the sheet.
    ActiveSheet.Name = txtPartNumber

    'Add data to powerpoint object.
    Worksheets(Me.txtPartNumber.Value).Shapes("Object 1").Select 
    Selection.Verb Verb:=xlOpen
    Dim p As PowerPoint.Presentation
    Set p = Selection.Object
    ActivePresentation.Slides(1).Shapes("operationaltext1").TextFrame.TextRange.Text = Me.txtPartNumber.Value
    [a1].Select

    'Bring main sheet back to front if necessary.
    If chkBringToFront = False Then
        Sheets("Directory").Select
    End If

    'Copy input values to sheet.
    Dim lRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Directory")
    lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    With ws    
        'Create a link to the part design page with the part number text.
        ActiveSheet.Hyperlinks.Add Anchor:=.Cells(lRow, 1), Address:="", 
        SubAddress:=Me.txtPartNumber.Value & "!A1", 
        TextToDisplay:=Me.txtPartNumber.Value
        .Cells(lRow, 1).Value = Me.txtPartNumber.Value
        .Cells(lRow, 2).Value = Me.txtCustomer.Value
        .Cells(lRow, 3).Value = Me.cboSkydrol.Value
        .Cells(lRow, 4).Value = Me.cboPneumatic.Value
        .Cells(lRow, 5).Value = Me.cboFuel.Value
        .Cells(lRow, 6).Value = Me.cboRedOil.Value
        .Cells(lRow, 7).Value = Me.cboSpace.Value
        .Cells(lRow, 8).Value = Me.cboStyle.Value
        .Cells(lRow, 9).Value = Me.txtWeight.Value
        .Cells(lRow, 10).Value = Me.txtMaxPressure.Value
        .Cells(lRow, 11).Value = Me.txtOperatingPressure.Value
        .Cells(lRow, 12).Value = Me.txtProofPressure.Value
        .Cells(lRow, 13).Value = Me.txtBurstPressure.Value
        .Cells(lRow, 14).Value = Me.txtAmbientTemperature.Value
        .Cells(lRow, 15).Value = Me.txtFluidTemperature.Value
        .Cells(lRow, 16).Value = Me.txtPullIn.Value
        .Cells(lRow, 17).Value = Me.txtDropOut.Value
        .Cells(lRow, 18).Value = Me.txtCoilResistance.Value
        .Cells(lRow, 19).Value = Me.txtLeakage.Value
        .Cells(lRow, 20).Value = Me.txtFlow.Value
        .Cells(lRow, 21).Value = Me.txtNotes.Value
    End With

    'Clear all inputs.
    Me.cboSkydrol.Value = ""
    Me.cboPneumatic.Value = ""
    Me.cboFuel.Value = ""
    Me.cboRedOil.Value = ""
    Me.cboSpace.Value = ""
    Me.cboStyle.Value = ""
    Me.txtAmbientTemperature.Value = ""
    Me.txtBurstPressure.Value = ""
    Me.txtCoilResistance.Value = ""
    Me.txtDropOut.Value = ""
    Me.txtFlow.Value = ""
    Me.txtFluidTemperature.Value = ""
    Me.txtLeakage.Value = ""
    Me.txtMaxPressure.Value = ""
    Me.txtNotes.Value = ""
    Me.txtOperatingPressure.Value = ""
    Me.txtPartNumber.Value = ""
    Me.txtProofPressure.Value = ""
    Me.txtPullIn.Value = ""
    Me.txtWeight.Value = ""
    Me.txtCustomer.Value = ""
End Sub

PowerPoint演示文稿在单独的窗口中打开但没有任何更改 . 此外，我的其余VBA代码没有执行 . 虽然我只用了一周的时间来理解ExcelVBA编码 . 到目前为止，只是尝试了几个网站的Frankenstein代码 .

如果不在单独的窗口中打开幻灯片，我可以这样做吗？

我很欣赏一些意见 . :)

该工作簿包含工作表“幻灯片模板”和“目录” .

PowerPoint幻灯片名为“对象1” .

幻灯片中的目标texbox名为“operationaltext1” .

excel vba excel-vba powerpoint powerpoint-vba

2 回答

  • 0

    这里有一些代码插入了一个powerpoint幻灯片，向其中添加了文本并且还回读了文本

    如果你只需要一张幻灯片，那么这就适合你

    Option Explicit

Sub testPPslide()

    ' NOTE: this adds a slide everytime the code is run
    ' it will be the standard "click here to add title" slide

    Worksheets("Sheet1").Range("c1:d1") = ""

    Dim pps As OLEObject

    Set pps = Worksheets("Sheet1").OLEObjects.Add( _
            ClassType:="PowerPoint.Slide.12", _
            Link:=False, _
            DisplayAsIcon:=False)

'   pps.Verb Verb:=xlOpen                     ' this edits slide in standalone PP app
'   pps.Verb Verb:=xlPrimary                  ' this one opens PP in excel
    pps.Top = 40
    pps.Left = 60

    Dim ps As powerpoint.Slide
    Set ps = pps.Object

    ps.Shapes(1).TextFrame.TextRange.Text = "cccccccccc"
    ps.Shapes(2).TextFrame.TextRange.Text = "this works"

    Worksheets("Sheet1").Range("c1") = ps.Shapes(1).TextFrame.TextRange.Text
    Worksheets("Sheet1").Range("d1") = ps.Shapes(2).TextFrame.TextRange.Text

End Sub
    回复于
  • 0

    这个适用于演示文稿

    示例代码

    Option Explicit


Sub testPPpresentation()

    ' NOTE: adds a PP presentation to the worksheet each time it is run

    Worksheets("Sheet1").Range("c1:d1") = ""

    Dim aaa As OLEObject
    Set aaa = Worksheets("Sheet1").OLEObjects.Add( _
                ClassType:="PowerPoint.Show.12", _
                Link:=False, _
                DisplayAsIcon:=False)

'   aaa.Verb Verb:=xlOpen       ' this edits the presentation in standalone PP app
'   aaa.Verb Verb:=xlPrimary    ' this one edits the presentation in excel

    aaa.Top = 90
    aaa.Left = 60

    Dim ppp As PowerPoint.Presentation
    Set ppp = aaa.Object

    ppp.Slides(1).Shapes(1).TextFrame.TextRange.Text = "cccccccccc"
    ppp.Slides(1).Shapes(2).TextFrame.TextRange.Text = "this works"

    Worksheets("Sheet1").Range("c1") = ppp.Slides(1).Shapes(1).TextFrame.TextRange.Text
    Worksheets("Sheet1").Range("d1") = ppp.Slides(1).Shapes(2).TextFrame.TextRange.Text

End Sub
    回复于

相关问题