Fernsteuerung: Unterschied zwischen den Versionen

Aus VBA-wiki
Zur Navigation springen Zur Suche springen
(Die Seite wurde neu angelegt: „== Zugriff auf PowerPoint == Bei PowerPoint reagiert 'CreateObject' wie folgt: * Wenn PowerPoint noch nicht läuft, wird es im Hintergrund gestartet. * Wenn P…“)
 
Keine Bearbeitungszusammenfassung
 
(2 dazwischenliegende Versionen desselben Benutzers werden nicht angezeigt)
Zeile 1: Zeile 1:
[[Category:vba-wiki]]
== Zugriff auf PowerPoint ==
== Zugriff auf PowerPoint ==


Zeile 8: Zeile 9:
Alternativ kann die Verbindung mit 'GetObject' hergestellt werden (siehe Beispiel für Word).
Alternativ kann die Verbindung mit 'GetObject' hergestellt werden (siehe Beispiel für Word).


  <span style="Color:#0000FF;">Public Sub </span>InsertFormInPPT()
<span style="Color:blue">Public Sub </span>InsertFormInPPT<span style="Color:gray">()</span>
    <span style="Color:#0000FF;">Dim </span>shp <span style="Color:#0000FF;">As </span>PowerPoint.Shape
    <span style="Color:blue"> Dim </span>shp<span style="Color:blue"> As </span>PowerPoint<span style="Color:gray">.</span>Shape
    <span style="Color:#0000FF;">Dim </span>sld <span style="Color:#0000FF;">As </span>PowerPoint.Slide
    <span style="Color:blue"> Dim </span>sld<span style="Color:blue"> As </span>PowerPoint<span style="Color:gray">.</span>Slide
    <span style="Color:#0000FF;">Dim </span>pptApp <span style="Color:#0000FF;">As </span>PowerPoint.Application
    <span style="Color:blue"> Dim </span>pptApp<span style="Color:blue"> As </span>PowerPoint<span style="Color:gray">.</span>Application
      
      
     <span style="Color:#008000;">' Voraussetzung: PowerPoint ist als Verweis eingebunden
     <span style="Color:green">' Voraussetzung: PowerPoint ist als Verweis eingebunden</span>
</span>  
   
     <span style="Color:#008000;">' Anwendungsvariable mit PowerPoint verknüpfen
     <span style="Color:green">' Anwendungsvariable mit PowerPoint verknüpfen</span>
</span>   <span style="Color:#008000;">' Wenn PowerPoint nicht schon läuft, wird ein Hintergrundprozess gestartet
    <span style="Color:green">' Wenn PowerPoint nicht schon läuft, wird ein Hintergrundprozess gestartet</span>
</span>   <span style="Color:#0000FF;">Set </span>pptApp <span style="Color:#993300;">= </span>CreateObject(<span style="Color:#808080;">"PowerPoint.Application"</span>)
    <span style="Color:blue"> Set </span>pptApp <span style="Color:gray">=</span> CreateObject<span style="Color:gray">("PowerPoint.Application")</span>
     <span style="Color:#008000;">' Wenn PowerPoint vorher schon vom Anwender gestartet wurde,
     <span style="Color:green">' Wenn PowerPoint vorher schon vom Anwender gestartet wurde,</span>
</span>   <span style="Color:#008000;">' ist die Anwendung sichtbar (auch wenn sie minimiert wurde)
    <span style="Color:green">' ist die Anwendung sichtbar (auch wenn sie minimiert wurde)</span>
</span>   <span style="Color:#008000;">' Wenn PowerPoint jetzt erst als Hintergrundprozess gestartet wurde, ist die Anwendung NICHT sichtbar
    <span style="Color:green">' Wenn PowerPoint jetzt erst als Hintergrundprozess gestartet wurde, ist die Anwendung NICHT sichtbar</span>
</span>   <span style="Color:#0000FF;">If </span>pptApp.Visible <span style="Color:#993300;">= </span>False Then <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> If </span>pptApp<span style="Color:gray">.</span>Visible <span style="Color:gray">=</span><span style="Color:blue"> False Then Exit Sub</span>
     <span style="Color:#008000;">' Mit der Referenz auf PowerPoint in der Variablen 'pptApp'
     <span style="Color:green">' Mit der Referenz auf PowerPoint in der Variablen 'pptApp'</span>
</span>   <span style="Color:#008000;">' kann nun direkt auf PowerPoint zugegriffen werden.
    <span style="Color:green">' kann nun direkt auf PowerPoint zugegriffen werden.</span>
</span>   <span style="Color:#0000FF;">If </span>pptApp.Presentations.Count <span style="Color:#993300;"><</span> <span style="Color:#00FFFF;">1 </span>Then <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> If </span>pptApp<span style="Color:gray">.</span>Presentations<span style="Color:gray">.</span>Count <span style="Color:gray"><</span> <span style="Color:gray">1</span><span style="Color:blue"> Then Exit Sub</span>
    <span style="Color:#0000FF;">If </span>pptApp.ActivePresentation.Slides.Count <span style="Color:#993300;"><</span> <span style="Color:#00FFFF;">1 </span>Then <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> If </span>pptApp<span style="Color:gray">.</span>ActivePresentation<span style="Color:gray">.</span>Slides<span style="Color:gray">.</span>Count <span style="Color:gray"><</span> <span style="Color:gray">1</span><span style="Color:blue"> Then Exit Sub</span>
    <span style="Color:#0000FF;">If </span>pptApp.ActiveWindow.Selection.<span style="Color:#0000FF;">Type</span> <span style="Color:#993300;">= </span>ppSelectionNone Then <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> If </span>pptApp<span style="Color:gray">.</span>ActiveWindow<span style="Color:gray">.</span>Selection<span style="Color:gray">.</span>Type <span style="Color:gray">=</span> ppSelectionNone<span style="Color:blue"> Then Exit Sub</span>
    <span style="Color:#0000FF;">Set </span>sld <span style="Color:#993300;">= </span>pptApp.ActiveWindow.Selection.SlideRange.Item(<span style="Color:#00FFFF;">1</span>)
    <span style="Color:blue"> Set </span>sld <span style="Color:gray">=</span> pptApp<span style="Color:gray">.</span>ActiveWindow<span style="Color:gray">.</span>Selection<span style="Color:gray">.</span>SlideRange<span style="Color:gray">.</span>Item<span style="Color:gray">(1)</span>
    <span style="Color:#0000FF;">Set </span>shp <span style="Color:#993300;">= </span>sld.Shapes.AddShape(msoShapeRectangle, <span style="Color:#00FFFF;">10</span>, <span style="Color:#00FFFF;">10</span>, <span style="Color:#00FFFF;">230</span>, <span style="Color:#00FFFF;">120</span>)
    <span style="Color:blue"> Set </span>shp <span style="Color:gray">=</span> sld<span style="Color:gray">.</span>Shapes<span style="Color:gray">.</span>AddShape<span style="Color:gray">(</span>msoShapeRectangle<span style="Color:gray">,</span> <span style="Color:gray">10,</span> <span style="Color:gray">10,</span> <span style="Color:gray">230,</span> <span style="Color:gray">120)</span>
     shp.Fill.ForeColor.RGB <span style="Color:#993300;">= </span>vbMagenta
     shp<span style="Color:gray">.</span>Fill<span style="Color:gray">.</span>ForeColor<span style="Color:gray">.</span>RGB <span style="Color:gray">=</span> vbMagenta
     shp.TextFrame.TextRange.Text <span style="Color:#993300;">= </span>Excel.Application.Name
     shp<span style="Color:gray">.</span>TextFrame<span style="Color:gray">.</span>TextRange<span style="Color:gray">.</span>Text <span style="Color:gray">=</span> Excel<span style="Color:gray">.</span>Application<span style="Color:gray">.</span>Name<span style="Color:blue">
<span style="Color:#0000FF;">End Sub</span>
End Sub</span>


== Word ==
== Word ==
Zeile 44: Zeile 45:
* Wenn die Anwendung noch nicht läuft, wird ein Fehler erzeugt.
* Wenn die Anwendung noch nicht läuft, wird ein Fehler erzeugt.


  <span style="Color:#0000FF;">Public Sub </span>TransferTextToWord()
  <span style="Color:blue">Public Sub </span>TransferTextToWord<span style="Color:gray">()</span>
    <span style="Color:#0000FF;">Dim </span>wordApp <span style="Color:#0000FF;">As </span>Word.Application
    <span style="Color:blue"> Dim </span>wordApp<span style="Color:blue"> As </span>Word<span style="Color:gray">.</span>Application
    <span style="Color:#0000FF;">Dim </span>doc <span style="Color:#0000FF;">As </span>Word.Document
    <span style="Color:blue"> Dim </span>doc<span style="Color:blue"> As </span>Word<span style="Color:gray">.</span>Document
    <span style="Color:#0000FF;">Dim </span>rngWord <span style="Color:#0000FF;">As </span>Word.Range
    <span style="Color:blue"> Dim </span>rngWord<span style="Color:blue"> As </span>Word<span style="Color:gray">.</span>Range
   
    <span style="Color:green">' Voraussetzung: Word ist als Verweis eingebunden</span>
      
      
    <span style="Color:#008000;">' Voraussetzung: Word ist als Verweis eingebunden
    <span style="Color:blue"> On Error GoTo </span><span style="Color:gray">0</span>                 <span style="Color:green">' Setzt Fehlerspeicher auf 0 zurück</span>
</span>  
    <span style="Color:blue"> On Error Resume Next </span>           <span style="Color:green">' Falls ein Fehler auftritt, bitte weiter machen</span>
    On Error GoTo <span style="Color:#00FFFF;">0               </span> <span style="Color:#008000;">' Setzt Fehlerspeicher auf 0 zurück
    <span style="Color:green">' Achtung bei GetObject: Anwendung ist zweiter Parameter, erster bleibt leer!</span>
</span>   On Error Resume <span style="Color:#0000FF;">Next           </span> <span style="Color:#008000;">' Falls ein Fehler auftritt, bitte weiter machen
    <span style="Color:blue"> Set </span>wordApp <span style="Color:gray">=</span> GetObject<span style="Color:gray">(,</span> <span style="Color:gray">"Word.Application")</span>
</span>   <span style="Color:#008000;">' Achtung bei GetObject: Anwendung ist zweiter Parameter, erster bleibt leer!
    <span style="Color:blue"> If </span>Err<span style="Color:gray">.</span>Number <span style="Color:gray"><></span> <span style="Color:gray">0</span><span style="Color:blue"> Then </span>        <span style="Color:green">' Wenn Fehlernummer ungleich 0, dann ...</span>
</span>   <span style="Color:#0000FF;">Set </span>wordApp <span style="Color:#993300;">= </span>GetObject(, <span style="Color:#808080;">"Word.Application"</span>)
        MsgBox <span style="Color:gray">"Bitte Word starten und gewünschtes Dokument öffnen!"</span>
    <span style="Color:#0000FF;">If </span>Err.Number <> <span style="Color:#00FFFF;">0 </span>Then         <span style="Color:#008000;">' Wenn Fehlernummer ungleich 0, dann ...
        <span style="Color:blue"> On Error GoTo </span><span style="Color:gray">0</span>             <span style="Color:green">' Schaltet 'On Error Resume Next' aus</span>
</span>       MsgBox <span style="Color:#808080;">"Bitte Word starten und gewünschtes Dokument öffnen!"</span>
        <span style="Color:blue"> Exit Sub</span>
        On Error GoTo <span style="Color:#00FFFF;">0           </span> <span style="Color:#008000;">' Schaltet 'On Error Resume Next' aus
    <span style="Color:blue"> End If</span>
</span>       <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> On Error GoTo </span><span style="Color:gray">0</span>                 <span style="Color:green">' Schaltet 'On Error Resume Next' aus
    <span style="Color:#0000FF;">End If</span>
  '    Debug.Print 3 / 0              ' Erzeugt keinen Fehler, wenn 'On Error GoTo 0' fehlt!</span>
    On Error GoTo <span style="Color:#00FFFF;">0               </span> <span style="Color:#008000;">' Schaltet 'On Error Resume Next' aus
    <span style="Color:blue"> If </span>wordApp<span style="Color:gray">.</span>Documents<span style="Color:gray">.</span>Count <span style="Color:gray">=</span> <span style="Color:gray">0</span><span style="Color:blue"> Then</span>
  '    Debug.Print 3 / 0              ' Erzeugt keinen Fehler, wenn 'On Error GoTo 0' fehlt!
         MsgBox <span style="Color:gray">"Bitte das gewünschte Dokument öffnen!"</span>
</span>   <span style="Color:#0000FF;">If </span>wordApp.Documents.Count <span style="Color:#993300;">=</span> <span style="Color:#00FFFF;">0 </span>Then
        <span style="Color:blue"> Exit Sub</span>
         MsgBox <span style="Color:#808080;">"Bitte das gewünschte Dokument öffnen!"</span>
    <span style="Color:blue"> End If</span>
        <span style="Color:#0000FF;">Exit Sub</span>
    <span style="Color:blue"> Set </span>doc <span style="Color:gray">=</span> wordApp<span style="Color:gray">.</span>ActiveDocument
    <span style="Color:#0000FF;">End If</span>
    <span style="Color:blue"> Set </span>rngWord <span style="Color:gray">=</span> doc<span style="Color:gray">.</span>Words<span style="Color:gray">.</span>Item<span style="Color:gray">(3)</span>
    <span style="Color:#0000FF;">Set </span>doc <span style="Color:#993300;">= </span>wordApp.ActiveDocument
     rngWord<span style="Color:gray">.</span>Text <span style="Color:gray">=</span> Cells<span style="Color:gray">(1,</span> <span style="Color:gray">1).</span>Text & <span style="Color:gray">" "</span><span style="Color:blue">
    <span style="Color:#0000FF;">Set </span>rngWord <span style="Color:#993300;">= </span>doc.Words.Item(<span style="Color:#00FFFF;">3</span>)
End Sub</span>
     rngWord.Text <span style="Color:#993300;">= </span>Cells(<span style="Color:#00FFFF;">1</span>, <span style="Color:#00FFFF;">1</span>).Text <span style="Color:#993300;">&</span> <span style="Color:#808080;">" "</span>
<span style="Color:#0000FF;">End Sub</span>

Aktuelle Version vom 28. Januar 2023, 00:35 Uhr

Zugriff auf PowerPoint

Bei PowerPoint reagiert 'CreateObject' wie folgt:

  • Wenn PowerPoint noch nicht läuft, wird es im Hintergrund gestartet.
  • Wenn PowerPoint schon läuft, wird dieses über 'CreateObject' zurückgegeben.
  • Wenn das Objekt freigegeben wird (spätestens am Ende der Prozedur), wird der Hintergrundprozess ebenfalls beendet.

Alternativ kann die Verbindung mit 'GetObject' hergestellt werden (siehe Beispiel für Word).

Public Sub InsertFormInPPT()
    Dim shp As PowerPoint.Shape
    Dim sld As PowerPoint.Slide
    Dim pptApp As PowerPoint.Application
    
    ' Voraussetzung: PowerPoint ist als Verweis eingebunden
    
    ' Anwendungsvariable mit PowerPoint verknüpfen
    ' Wenn PowerPoint nicht schon läuft, wird ein Hintergrundprozess gestartet
    Set pptApp = CreateObject("PowerPoint.Application")
    ' Wenn PowerPoint vorher schon vom Anwender gestartet wurde,
    ' ist die Anwendung sichtbar (auch wenn sie minimiert wurde)
    ' Wenn PowerPoint jetzt erst als Hintergrundprozess gestartet wurde, ist die Anwendung NICHT sichtbar
    If pptApp.Visible = False Then Exit Sub
    ' Mit der Referenz auf PowerPoint in der Variablen 'pptApp'
    ' kann nun direkt auf PowerPoint zugegriffen werden.
    If pptApp.Presentations.Count < 1 Then Exit Sub
    If pptApp.ActivePresentation.Slides.Count < 1 Then Exit Sub
    If pptApp.ActiveWindow.Selection.Type = ppSelectionNone Then Exit Sub
    Set sld = pptApp.ActiveWindow.Selection.SlideRange.Item(1)
    Set shp = sld.Shapes.AddShape(msoShapeRectangle, 10, 10, 230, 120)
    shp.Fill.ForeColor.RGB = vbMagenta
    shp.TextFrame.TextRange.Text = Excel.Application.Name
End Sub

Word

Bei Word reagiert 'CreateObject' wie folgt:

  • Wenn Word noch nicht läuft, wird ein neuer Hintergrundprozess gestartet.
  • Wenn Word schon läuft, wird trotzdem ein neuer Hintergrundprozess gestartet!
  • Wenn das Objekt freigegeben wird, bleibt der Hintergrundprozess erhalten!

Bei 'GetObject' gilt folgendes:

  • Wenn die Anwendung schon läuft, wird dessen Instanz zurückgegeben.
  • Wenn die Anwendung noch nicht läuft, wird ein Fehler erzeugt.
Public Sub TransferTextToWord()
    Dim wordApp As Word.Application
    Dim doc As Word.Document
    Dim rngWord As Word.Range
    
    ' Voraussetzung: Word ist als Verweis eingebunden
    
    On Error GoTo 0                 ' Setzt Fehlerspeicher auf 0 zurück
    On Error Resume Next            ' Falls ein Fehler auftritt, bitte weiter machen
    ' Achtung bei GetObject: Anwendung ist zweiter Parameter, erster bleibt leer!
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then         ' Wenn Fehlernummer ungleich 0, dann ...
        MsgBox "Bitte Word starten und gewünschtes Dokument öffnen!"
        On Error GoTo 0             ' Schaltet 'On Error Resume Next' aus
        Exit Sub
    End If
    On Error GoTo 0                 ' Schaltet 'On Error Resume Next' aus
'    Debug.Print 3 / 0               ' Erzeugt keinen Fehler, wenn 'On Error GoTo 0' fehlt!
    If wordApp.Documents.Count = 0 Then
        MsgBox "Bitte das gewünschte Dokument öffnen!"
        Exit Sub
    End If
    Set doc = wordApp.ActiveDocument
    Set rngWord = doc.Words.Item(3)
    rngWord.Text = Cells(1, 1).Text & " "
End Sub