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

我正在构build一个数据库，提供大量产品devise信息。 我select使用带有用户input的Excel文件作为devise细节，以便通过细节轻松过滤，然后select包含带有照片和devise注释的embedded式PowerPoint的相应页面的链接。 目前，我有一个模板，复制到一个新的选项卡，重命名并创build一个链接到基于文本框部件号input的目录中的选项卡。 我可能会问太多，但我也希望用户窗体向PowerPoint演示文稿中预先存在的文本框添加文本。 到目前为止，一切都很顺利。

我发现了一个类似的问题，并尝试了几次代码。

从Excel VBA编辑embedded的PowerPoint

这对理解有帮助，但在这方面对我没有帮助：

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编码。 到目前为止，一直只是尝试从几个网站的弗兰肯斯坦代码。

我可以做到这一点，而无需在单独的窗口中打开幻灯片？

我会欣赏一些input。 🙂

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

PowerPoint幻灯片被命名为“对象1”。

幻灯片中的目标texbox被命名为“operationaltext1”。

Answer 1

这里是一些代码，插入幻灯片幻灯片，添加文本，也读回文本

如果你只需要一张幻灯片，那么这是给你的

 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 

Answer 2

这个在演示上工作

示例代码

 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