Consulting

Results 1 to 10 of 10

Thread: Use Regex in VBA to replace text between tags in PowerPoint (multiple occurences)

  1. #1

    Use Regex in VBA to replace text between tags in PowerPoint (multiple occurences)

    Hi,

    I am struggling with the following problem:

    My goal is to replace some text in the slide notes of a PowerPoint file using VBA. If the text in the slide notes looks like this (single occurence of the tag to be deleted) my code below works. However, for multiple occurences of the tags it does not work correctly.

    The input in this case looks like this:

        This is a first sentence. 
        <code1>This second sentence needs to be deleted.</code1>
        Here is a third sentence. This one should be kept.
        <code1>This fourth sentence needs to be deleted as well.</code1>
    An the wrong output like this:

        This is a first sentence.
    Actually, I want to have this:

        This is a first sentence. 
        Here is a third sentence. This one should be kept.
    I would appreciate any advice on how to change the code below.

        Sub sync_text()
            
            input_text = ActivePresentation.Slides(1).NotesPage.Shapes(2).TextFrame.TextRange.Text
            
            ' Delete code1
            Set regX_delete = CreateObject("vbscript.regexp")
            With regX_delete
            .Global = True
            .Pattern = "<code1>(.+)</code1>"
            End With
            
            output_text = regX_delete.Replace(input_text, " ")
            
            ActivePresentation.Slides(1).NotesPage.Shapes(2).TextFrame.TextRange.Text = output_text
               
        End Sub
    Thanks for your help!

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,881
    Location
    A: Always declare variables!
    B. You have st the pattern to be "GREEDY" - this means it will look for the first <code1> and keep looking till it gets to the last </code1> and delete everything in between. Use a ? in the pattern to set to NON GREEDY

    Sub sync_text()
    'Declare variables
            Dim input_text As String
            Dim output_text As String
            Dim regX_delete As Object
            input_text = ActivePresentation.Slides(1).NotesPage.Shapes(2).TextFrame.TextRange.Text
            
            ' Delete code1
            Set regX_delete = CreateObject("vbscript.regexp")
            With regX_delete
            .Global = True
            .Pattern = "<code1>(.+?)</code1>"
            End With
            
            output_text = regX_delete.Replace(input_text, " ")
            
            ActivePresentation.Slides(1).NotesPage.Shapes(2).TextFrame.TextRange.Text = output_text
               
        End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,881
    Location
    Note this is not the most efficient way to search but it is probably fast enough and easier to understand.

    .Global = True
    .Pattern = "<code1>[^<]*</code1>"

    would run faster but unless you have a huge file you will not notice. It searches for anything between the tags EXCEPT '<'(the start of the next tag)
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  4. #4
    Thanks for your help (and also the advice on delcaring all variables)!

    Works great.

  5. #5
    Thanks again, the code works great on Windows.

    However, I just learned that on Mac the code won't run. The following line throws an error:
    regX_delete = CreateObject("vbscript.regexp"
    Is there any way to do implement this "search & replace" procedure such that it works for both Windows & Mac?

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,881
    Location
    Not as far as I know. I don;'t think you can run a regX object ona Mac but then I'm not a Mac person!
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  7. #7
    That's unfortunate, but after googling for a while I was kind of expecting this. Would it theoretically be possible to "translate" this regex to a bit more complex code chunk that uses the find() method. That means, first identifying how many <code1> tags exist. Next, looping over this number deleting everything from the first character of the first appearance of <code1> to the last character of the first appearance of </code1>, and so on. My assumption is that such a code would run on a Mac.

    Does this make sense/ would this be feasible?

  8. #8
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,767
    Location
    Maybe ....

    Option Explicit
    
    
    Sub NotRegEx()
        Dim oSlide  As Slide
        
        For Each oSlide In ActivePresentation.Slides
            
            If Not oSlide.HasNotesPage Then GoTo NextSlide
            
            With oSlide.NotesPage.Shapes(2)
                If Not .HasTextFrame Then GoTo NextSlide
                    
                If Not .TextFrame.HasText Then GoTo NextSlide
                    
                If Len(.TextFrame.TextRange.Text) = 0 Then GoTo NextSlide
                    
                .TextFrame.TextRange.Text = DeleteTags(.TextFrame.TextRange.Text, "code1")
            End With
        
    NextSlide:
        Next
    
    End Sub
    
    
    'only tag, function adds <s> and </s>
    Function DeleteTags(s As String, t As String) As String
        Dim sStart As String, sEnd As String
        Dim iStart As Long, iEnd As Long
    
    
        sStart = "<" & t & ">"
        sEnd = "</" & t & ">"
        
        
        iStart = InStr(1, s, sStart, vbTextCompare)
        iEnd = InStr(1, s, sEnd, vbTextCompare)
        
        Do While iStart > 0 And iEnd > 0
            'start tag at beginning
            If iStart = 1 Then
                s = Right(s, Len(s) - iEnd - Len(sEnd) + 1)
            Else
                s = Left(s, iStart - 1) & Right(s, Len(s) - iEnd - Len(sEnd) + 1)
            End If
    
    
            iStart = InStr(1, s, sStart, vbTextCompare)
            iEnd = InStr(1, s, sEnd, vbTextCompare)
        
        Loop
    
    
        DeleteTags = s
    
    
    End Function
    Last edited by Paul_Hossler; 11-08-2019 at 02:31 PM. Reason: Pasted in wrong version :-(
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,881
    Location
    Nice Code. I was about to post this which does pretty much the same thing.

    Sub notRegX2()
    Dim oshp As Shape
    Dim osld As Slide
    Dim otxr2 As TextRange2
    Dim lngStart As Long
    Dim lngEnd As Long
    For Each osld In ActivePresentation.Slides
    For Each oshp In osld.NotesPage.Shapes
    If oshp.HasTextFrame Then
    If oshp.TextFrame2.HasText Then
    Set otxr2 = oshp.TextFrame2.TextRange
    While InStr(otxr2.Text, "<code1>") > 0
    lngStart = InStr(otxr2.Text, "<code1>")
    lngEnd = InStr(otxr2.Text, "</code1>") + Len("</code1>")
    otxr2.Characters(lngStart, lngEnd - lngStart).Delete
    Wend
    End If
    End If
    Next oshp
    Next osld
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  10. #10
    Nice, indeed! Thanks Paul and John.

    Both solutions work on Mac! This helps me a lot to make the script work for all my colleagues.

    Thanks again for your help!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •