2017-10-25 2 views
2

Ich baue eine Datenbank mit Informationen über eine große Sammlung von Produktdesigns. Ich entschied mich, eine Excel-Datei mit Benutzerformulareingabe für die Designdetails zu verwenden, um einfach nach Details zu filtern, und wähle dann einen Link zu der entsprechenden Seite, die ein eingebettetes PowerPoint mit Fotos und Designnotizen enthält. Im Moment habe ich eine Vorlage, die in eine neue Registerkarte kopiert, benennt und erstellt eine Verknüpfung zu der Registerkarte in einem Verzeichnis basierend auf Textfeld Eingabe der Teilenummer. Ich könnte zu viel fragen, aber ich möchte auch, dass das Benutzerformular Text zu bereits vorhandenen Textfeldern in der PowerPoint-Präsentation hinzufügt. Alles funktioniert bis jetzt ziemlich gut.Wie kann ich eine in Excel eingebettete PowerPoint-Präsentation mit Excel VBA und Benutzerformular bearbeiten

Ich fand eine ähnliche Frage und versuchte meine Hand bei der Codierung mehrmals.

Editing Embedded PowerPoint from Excel VBA

Es war in Verständnis hilfreich, aber es nicht für mich in diesem Zusammenhang arbeiten:

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 

Die Powerpoint-Präsentation in einem separaten Fenster geöffnet wurde aber nichts geändert. Außerdem wurde der Rest meines VBA-Codes nicht ausgeführt. Obwohl ich nur eine Woche in meinem Verständnis von ExcelVBA-Codierung bin. Bisher habe ich gerade Frankenstein-Code von mehreren Seiten aus probiert.

Kann ich dies tun, ohne die Folie in einem separaten Fenster zu öffnen?

Ich würde einige Eingaben schätzen. :)

Die Arbeitsmappe enthält die Arbeitsblätter "Folienvorlage" und "Verzeichnis".

Die PowerPoint-Folie heißt "Objekt 1".

Die Zieltexbox in der Folie heißt "operationaltext1".

Antwort

0

hier ist ein Code, der eine Powerpoint-Folie einfügt, fügt Text ihm und liest auch der Text

zurück, wenn Sie nur eine Folie benötigen, dann ist dies für Sie

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

Das funktionierte perfekt! Ich renne jetzt zu einem anderen Problem, wo das Objekt nicht gefunden wird, es sei denn, die Folie ist bereits vorhanden. Wenn ich die Folie zuerst erstelle, funktioniert es großartig, aber wenn ich versuche, es von VBA aus dem gleichen Klick-Ereignis zu tun, erhalte ich den Fehler "Laufzeitfehler '1004': Kann die Objekteigenschaft der OLEObject-Klasse nicht abrufen." Ich glaube, der Code läuft auf einmal und findet die neue Folie noch nicht. Gibt es eine Möglichkeit, die Folie zuerst zu kopieren und dann die Werte mit einem einzigen Klick einzugeben? – TrCCper

+0

Es tut mir leid, ich glaube nicht, dass ich mich selbst gut genug erklärt habe. Ich kann Code schreiben, um eine Folie einzufügen. Das ist nicht das Problem. Ich habe Code, der ein vorhandenes Arbeitsblatt mit einer bereits eingebetteten PowerPoint-Folie kopiert. Ich muss nur Text zu vorhandenen Textfeldern innerhalb der Folie hinzufügen. Ich habe es so gemacht, weil die Vorlage, die ich kopiere, bereits formatiert ist. d. h .: Schrift, Größe, Kopf- und Fußzeile, Datumsfeld, 4 separate Informationsfelder und deren Platzierung auf der Folie. Ich denke, dass der Fehler von dem Versuch resultiert, die Folie zu kopieren, umzubenennen UND Text von einem einzelnen "cmdOK" -Knopf-Klick einzugeben. – TrCCper

+0

nur zur Bestätigung, es ist eine Folie, keine Präsentation. Ist das korrekt? .... warum kopierst du die Folie?dieser Teil ist mir nicht klar, weil du gesagt hast, dass das Arbeitsblatt einen eingebetteten Powerpoint hat (Folie/Präsentation) – jsotola

0

Dieses funktioniert auf

Präsentationen

Beispielcode

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 
Verwandte Themen