![](/img/trans.png)
[英]Excel VBA Can't SaveAs Embedded PowerPoint Presentation in Office 2016
[英]How can I edit a PowerPoint presentation embedded in Excel using Excel VBA and userform
我正在建立一個包含大量產品設計信息的數據庫。 我選擇使用帶有用戶窗體輸入的Excel文件作為設計詳細信息,以便輕松按詳細信息進行過濾,然后選擇一個指向相應頁面的鏈接,該頁面包含帶有照片和設計說明的嵌入式PowerPoint。 目前,我有一個模板,可根據零件號的文本框輸入復制到新選項卡,重命名並在目錄中創建指向該選項卡的鏈接。 我可能要問的太多了,但是我也希望用戶窗體將文本添加到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編碼的理解只有一周的時間。 到目前為止,僅在幾個站點上嘗試了Frankenstein代碼。
我可以在沒有在單獨的窗口中打開幻燈片的情況下執行此操作嗎?
我將不勝感激。 :)
該工作簿包含工作表“幻燈片模板”和“目錄”。
PowerPoint幻燈片名為“對象1”。
幻燈片中的目標texbox名為“ operationaltext1”。
這是一些代碼,可插入幻燈片,向其中添加文本並向后讀取文本
如果您只需要一張幻燈片,那么這個適合您
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
此作品適用於演示文稿
示例代碼
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.