Office: (Office 2010) Durch Schleife Namen von Textfeldern ändern

Hallo Leute,

ich stehe vor folgendem Problem:

Ich muss in einer Präsentation von mehreren hundert Seiten die Bezeichnungen der Textboxen ändern, damit von einer Access Datenbank auf diese entsprechend verwiesen werden kann.
Dies muss so geschehen, dass heirbei nach einem Wort in der Textbox gesucht wird. Z.b. "<Haus>" und es sollen dann alle Namen der Textfelder die dieses Wort enthalten z.B. "txtHaus" genannt werden.

Die Präsentation soll also Folie pro Folie durchlaufen und in jedes Textfeld reinschauen ob es das bestimmte Wort enthält und falls ja, den Namen des Textfeldes ändern.

Ich habe schon lange rumprobiert aber bisher nichts lauffähiges hinbekommen.

Vielleicht weiß es ja jemand.

Dies ist mein Ansatz:

Sub Shapes_umbennen()

'Nach Textfeldern suchen
Dim Folie As Slide
Dim Textfeld As Object



For Each Folie In ActivePresentation.Slides 'Für jede Folie in der PPT
For Each Textfeld In Folie.Shapes 'für jedes Textfeld in der PPT
'If Textfeld.TextFrame.HasText("<Haus>") Then


ActiveWindow.Selection.ShapeRange.Name = "txtHaus" 'Ändert den Namen des Shapes
End If






Next Textfeld
Next Folie

End Sub

 

Hallo,

der folgende VBA-Code müsste deine Wünsche erfüllen. Ich konnte den Code nicht wirklich testen, da du kein PPT-Dokument mitgeliefert hast.
Auf alle Fälle musst du die beiden Konstanten "PfadDatei_PPT" und "AbfrageText" entsprechend anpassen.
Wie weit die beiden "<" bzw. ">" eine Bedeutung haben, war mir ebenfalls nicht wirklich klar.

Code:

Option Explicit

'#Const EARLY_BINDING = True

Sub BenenneUm_TextBoxen_Presentation()
    
'  #If EARLY_BINDING Then
'    Dim ppApp As New PowerPoint.Application
'    Dim Pres  As PowerPoint.Presentation
'    Dim Sld   As PowerPoint.Slide
'    Dim Shp   As PowerPoint.Shape
'  #Else
     Dim ppApp As Object 'New PowerPoint.Application
     Dim Pres  As Object 'PowerPoint.Presentation
     Dim Sld   As Object 'PowerPoint.Slide
     Dim Shp   As Object 'PowerPoint.Shape
     Set ppApp = CreateObject("Powerpoint.Application")
     Const msoOLEControlObject = 12
'  #End If
  
    Dim Txt  As String
    
    Const PfadDatei_PPT As String = "C:\PowerPoint\Demo.pptx" '<--- Anpassen!!
    Const AbfrageText As String = "Haus"                      '<--- Anpassen!!
    
    
    With ppApp
        Set Pres = .Presentations.Open(FileName:=PfadDatei_PPT$)
        For Each Sld In Pres.Slides
           For Each Shp In Sld.Shapes
             If Shp.Type = msoOLEControlObject Then
               'Es handelt sich um ein OLE-ControlObjekt
               If InStr(UCase(Shp.OLEFormat.ProgID), "TEXTBOX") Then
                 'Es handelt sich dabei um eine TextBox
                 Txt$ = Shp.OLEFormat.Object.Text
                 'Überprüfe, ob der Inhalt der Konstanten AbfrageText
                 'im Textinhalt der TextBox enthalten ist:
                 If InStr(UCase(Txt$), UCase(AbfrageText)) Then
                   'Ja, er ist enthalten: Ändere den Namen der TextBox:
                   Shp.Name = "txt" & AbfrageText
                 End If
               End If
             End If
           Next Shp
        Next Sld
        Pres.Close
    End With
    Set ppApp = Nothing
End Sub