Announcement

Collapse
No announcement yet.

Replace Funktion in VBA PowerPoint

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Replace Funktion in VBA PowerPoint

    Hallo,

    ich habe folgendes Problem:
    Ich würde gerne mit VBA eine Power Point Presentation durchsuchen und bestimmte Wörter ersetzen.
    Das geht wohl mit der Replace Funktion, die aber immer auf jedes Textfeld etc. angewendet werden muss. Jetzt habe ich aber das Problem, dass ich nicht weis wie ich die Tabellen und Graphiken in einer Präsentation anwählen kann, so dass ich den darin enthaltenen Text in das Range Objekt laden kann, in dem ich dann die Wörter mit Replace ersetzen kann.

    Ich habe den Code unten gepostet. Der Kern stammt aus der Windows VBA Hilfe (wenn man den VBA HilfeCode direkt nimmt klappt es leider auch nicht).

    Vielen Dank für EUre Hilfe schonmal im VOraus


    Amborag

    P.S.:
    Wenn jemand noch andere Vorschläge hat wie man Text am besten ersetzt sind die mir natürlich mehr als willkommen. Ich haenge nicht an der Replace FUnktion

    Sub ReplaceText(SearchText As String, ReplacementText As String)
    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    Dim CurrObj As Object
    Dim TOP As Integer
    Dim z As Integer
    '
    frmUpdate.Hide
    For i = 2 To Application.ActivePresentation.Slides.Count
    Set oSld = Application.ActivePresentation.Slides(i)
    TOP = oSld.Shapes.Count
    For j = 1 To TOP
    For z = 1 To 500
    Set oShp = ActivePresentation.Slides(i).Shapes(j)
    If oShp.HasTextFrame = msoTrue Then
    Set oTxtRng = oShp.TextFrame.TextRange
    On Error Resume Next
    Set oTmpRng = oTxtRng.Replace(findwhat:=SearchText, replacewhat:=ReplacementText, wholewords:=msoFalse)
    Else
    oShp.Select
    Set oTmpRng = Selection.Replace(findwhat:=SearchText, replacewhat:=ReplacementText, wholewords:=msoFalse)
    Debug.Print oShp
    End If
    Next z
    Next j
    Next i
    End Sub
    Zuletzt editiert von Amborag; 05.12.2007, 11:18.
Working...
X