Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 29

Thread: delete all styles but to keep the font, bold etc. format

  1. #1

    Question delete all styles but to keep the font, bold etc. format

    I'm trying to figure out how to change the code below posted by
    Paul Edstein answering a similar thread, but I cannot put the link below, so I'll post the name of the thread:
    'Unwanted style name aliases in Word'

    The similar thread was related to deleting the aliases from the name of the styles finishing with 'char' ou '* char'

    the point is, I want almost the same thing, but instead of deleting just styles having '* char' in the name, I want to delete all styles, except the hard/internal ones, and I want to keep the format (bold, italic, font name and size, etc).

    what I already tried:
    in the sub DeleteCharCharStylesKeepFormatting I deleted the conditionals 'if' and the loop: 'do while', so I could free the code deleted all the styles and not only those with 'char' in their names. ...the rest of the code inside the 'functions' I didn't change because I guess nothing needed to be done.

    I believe it's goes to an infinity loop in the text: .Execute from the code:
    Do
        With rngResult.Find
        .ClearFormatting
        .Style = sty
        .Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Execute
       End With

    below is the original code to delete the styles with the 'char' in their name, and in the end of the text I'll post the code that I changed, and of course, its not working.

    Sub DeleteCharCharStylesKeepFormatting( )
      Dim sty As Style
      Dim i As Integer
      Dim doc As Document
      Dim sStyleName As String
      Dim sStyleReName As String
      Dim bCharCharFound As Boolean
    Set doc = ActiveDocument
      Do
        bCharCharFound = False
        For i = doc.Styles.Count To 1 Step -1
            Set sty = doc.Styles(i)
            sStyleName = sty.NameLocal
            If sStyleName Like "* Char*" Then
                bCharCharFound = True
                If sty.Type = wdStyleTypeCharacter Then
                    Call StripStyleKeepFormatting(sty, doc)
                    On Error Resume Next
                    ' COMMENT OUT THE NEXT LINE IN WORD 2000 OR 97
                    sty.LinkStyle = wdStyleNormal
                    sty.Delete
                    Err.Clear
                Else
                    sStyleReName = Replace(sStyleName, " Char", "")
                    On Error Resume Next
                    sty.NameLocal = sStyleReName
                    If Err.Number = 5173 Then
                        Call SwapStyles(sty, doc.Styles(sStyleReName), doc)
                        sty.Delete
                        Err.Clear
                    Else
                        On Error GoTo ERR_HANDLER
                    End If
                End If
                Exit For
            End If
            Set sty = Nothing
        Next i
     Loop While bCharCharFound = True
     Exit Sub
    ERR_HANDLER:
    MsgBox "An Error has occurred" & vbCr & _
            Err.Number & Chr(58) & Chr(32) & Err.Description, _
            vbExclamation
    End Sub
    
    Function SwapStyles(ByRef styFind As Style, _
                        ByRef styReplace As Style, _
                        ByRef doc As Document)
    With doc.Range.Find
        .ClearFormatting
        .Text = ""
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Style = styFind
        .Replacement.ClearFormatting
        .Replacement.Style = styReplace
        .Replacement.Text = "^&"
        .Execute Replace:=wdReplaceAll
    End With
    End Function
    
    Function StripStyleKeepFormatting(ByRef sty As Style, ByRef doc As Document)
    Dim rngToSearch As Range
    Dim rngResult As Range
    Dim f As Font
    Set rngToSearch = doc.Range
    Set rngResult = rngToSearch.Duplicate
    Do
        With rngResult.Find
            .ClearFormatting
            .Style = sty
            .Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Execute
        End With
        If Not rngResult.Find.Found Then Exit Do
        Set f = rngResult.Font.Duplicate
        With rngResult
             .Font.Reset
             .Font = f
             .MoveStart wdWord
             .End = rngToSearch.End
        End With
        Set f = Nothing
    Loop Until Not rngResult.Find.Found
    End Function
    modified code that I did something wrong below:

    Sub DeleteCharCharStylesKeepFormatting( )
      Dim sty As Style
      Dim i As Integer
      Dim doc As Document
      Dim sStyleName As String
      Dim sStyleReName As String
      Dim bCharCharFound As Boolean
    Set doc = ActiveDocument
      'Do
        'bCharCharFound = False
        For i = doc.Styles.Count To 1 Step -1
            Set sty = doc.Styles(i)
            sStyleName = sty.NameLocal
            'If sStyleName Like "* Char*" Then
                'bCharCharFound = True
                    'If sty.Type = wdStyleTypeCharacter Then
                        Call StripStyleKeepFormatting(sty, doc)
                        On Error Resume Next
                        ' COMMENT OUT THE NEXT LINE IN WORD 2000 OR 97
                        'sty.LinkStyle = wdStyleNormal(commented out because i'm using word 2000)
                        sty.Delete
                        Err.Clear
                    'Else
                        'sStyleReName = Replace(sStyleName, " Char", "")
                        'On Error Resume Next
                        'sty.NameLocal = sStyleReName
                        'If Err.Number = 5173 Then
                        'Call SwapStyles(sty, doc.Styles(sStyleReName), doc)
                        ' sty.Delete
                        'Err.Clear
                    'Else
                        'On Error GoTo ERR_HANDLER
                    'End If
                'End If
                'Exit For
            'End If
            Set sty = Nothing
        'Next I
    ' Loop While bCharCharFound = True
     Exit Sub
    ERR_HANDLER:
    MsgBox "An Error has occurred" & vbCr & Err.Number & Chr(58) & Chr(32) & Err.Description, _
            vbExclamation
    End Sub
    Last edited by Aussiebear; 04-21-2023 at 11:28 PM. Reason: Adjusted the code tags

  2. #2
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,710
    Location
    Please use the VBA code tags. It makes code easier to read. In particular you code as is make it very hard to see what is happening, with all the commented out lines.

    Can you say why you want to do this? It is very unusual.

  3. #3
    Quote Originally Posted by fumei
    Please use the VBA code tags. It makes code easier to read. In particular you code as is make it very hard to see what is happening, with all the commented out lines.

    Can you say why you want to do this? It is very unusual.

    I'm sorry, I'm really new in foruns and got no idea how to do that! can u please explain to me or send me the link to the page that explains how to?
    I'm sorry, I'm not lazy, just lost in here. ...I'll get better with time.

  4. #4
    I'm trying to figure out how to change the code below posted by
    Paul Edstein answering a similar thread, but I cannot put the link below, so I'll post the name of the thread:
    'Unwanted style name aliases in Word'

    The similar thread was related to deleting the aliases from the name of the styles finishing with 'char' ou '* char'

    the point is, I want almost the same thing, but instead of deleting just styles having '* char' in the name, I want to delete all styles, except the hard/internal ones, and I want to keep the format (bold, italic, font name and size, etc).

    what I already tried:
    in the sub DeleteCharCharStylesKeepFormatting I deleted the conditionals 'if' and the loop: 'do while', so I could free the code deleted all the styles and not only those with 'char' in their names. ...the rest of the code inside the 'functions' I didn't change because I guess nothing needed to be done.

    I believe it's goes to an infinity loop in the text: .Execute from the code:
    Do
    With rngResult.Find
        .ClearFormatting
        .Style = sty
        .Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Execute
    End With
    below is the original code to delete the styles with the 'char' in their name, and in the end of the text I'll post the code that I changed, and of course, its not working.


    Sub DeleteCharCharStylesKeepFormatting( )
    Dim sty As Style
    Dim i As Integer
    Dim doc As Document
    Dim sStyleName As String
    Dim sStyleReName As String
    Dim bCharCharFound As Boolean
    Set doc = ActiveDocument
    Do
        bCharCharFound = False
        For i = doc.Styles.Count To 1 Step -1
            Set sty = doc.Styles(i)
            sStyleName = sty.NameLocal
            If sStyleName Like "* Char*" Then
                bCharCharFound = True
                If sty.Type = wdStyleTypeCharacter Then
                    Call StripStyleKeepFormatting(sty, doc)
                    On Error Resume Next
                    ' COMMENT OUT THE NEXT LINE IN WORD 2000 OR 97
                    sty.LinkStyle = wdStyleNormal
                    sty.Delete
                    Err.Clear
                Else
                    sStyleReName = Replace(sStyleName, " Char", "")
                    On Error Resume Next
                    sty.NameLocal = sStyleReName
                    If Err.Number = 5173 Then
                        Call SwapStyles(sty, doc.Styles(sStyleReName), doc)
                        sty.Delete
                        Err.Clear
                    Else
                        On Error GoTo ERR_HANDLER
                    End If
                End If
                Exit For
            End If
            Set sty = Nothing
         Next i
    Loop While bCharCharFound = True
    Exit Sub
    ERR_HANDLER:
    MsgBox "An Error has occurred" & vbCr & _
    Err.Number & Chr(58) & Chr(32) & Err.Description, _
    vbExclamation
    End Sub
    
    Function SwapStyles(ByRef styFind As Style, _
    ByRef styReplace As Style, _
    ByRef doc As Document)
    With doc.Range.Find
        .ClearFormatting
        .Text = ""
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Style = styFind
        .Replacement.ClearFormatting
        .Replacement.Style = styReplace
        .Replacement.Text = "^&"
        .Execute Replace:=wdReplaceAll
    End With
    End Function
    
    
    Function StripStyleKeepFormatting(ByRef sty As Style, _
    ByRef doc As Document)
    Dim rngToSearch As Range
    Dim rngResult As Range
    Dim f As Font
    Set rngToSearch = doc.Range
    Set rngResult = rngToSearch.Duplicate
    Do
        With rngResult.Find
            .ClearFormatting
            .Style = sty
            .Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Execute
        End With
    If Not rngResult.Find.Found Then Exit Do
    Set f = rngResult.Font.Duplicate
    With rngResult
        .Font.Reset
        .Font = f
        .MoveStart wdWord
        .End = rngToSearch.End
    End With
    Set f = Nothing
    Loop Until Not rngResult.Find.Found
    End Function
    modified code that I did something wrong below:

    Sub DeleteCharCharStylesKeepFormatting( )
    Dim sty As Style
    Dim i As Integer
    Dim doc As Document
    Dim sStyleName As String
    Dim sStyleReName As String
    Dim bCharCharFound As Boolean
    Set doc = ActiveDocument
    'Do
        'bCharCharFound = False
        For i = doc.Styles.Count To 1 Step -1
            Set sty = doc.Styles(i)
            sStyleName = sty.NameLocal
            'If sStyleName Like "* Char*" Then
                'bCharCharFound = True
                'If sty.Type = wdStyleTypeCharacter Then
                   Call StripStyleKeepFormatting(sty, doc)
                   On Error Resume Next
                    ' COMMENT OUT THE NEXT LINE IN WORD 2000 OR 97
                    'sty.LinkStyle = wdStyleNormal(commented out because i'm using word 2000)
                    sty.Delete
                    Err.Clear
                'Else
                    'sStyleReName = Replace(sStyleName, " Char", "")
                    'On Error Resume Next
                    'sty.NameLocal = sStyleReName
                    'If Err.Number = 5173 Then
                       'Call SwapStyles(sty, doc.Styles(sStyleReName), doc)
                       ' sty.Delete
                       'Err.Clear
                       'Else
                       'On Error GoTo ERR_HANDLER
                'End If
            'End If
            'Exit For
        'End If
        Set sty = Nothing
    'Next i
    ' Loop While bCharCharFound = True
    Exit Sub
    ERR_HANDLER:
    MsgBox "An Error has occurred" & vbCr & Err.Number & Chr(58) & Chr(32) & Err.Description, vbExclamation
    End Sub
    Last edited by Aussiebear; 04-21-2023 at 11:43 PM. Reason: Adjusted the code tags

  5. #5
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    Remove the comment from the "Next i" line
    Remove the comment from the "On Error GoTo ERR_HANDLER" line

    That's what keeps you looping through all the styles and resets your error handler.

    You'll definitely want to test this code on different documents, as it can potentially cause issues with loss of direct formatting, character styles on top of paragraph styles, etc.

    But in general, it's going to work for you. You didn't post the StripStyleKeepFormatting function, but that should also stay as it was, I believe.
    _______________________________________________
    Please don't cross-post without providing links to your cross-posts. We answer questions for free. Please don't waste the time of the people helping you.
    For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

    - Frosty

  6. #6
    Quote Originally Posted by Frosty
    Remove the comment from the "Next i" line
    Remove the comment from the "On Error GoTo ERR_HANDLER" line

    That's what keeps you looping through all the styles and resets your error handler.

    You'll definitely want to test this code on different documents, as it can potentially cause issues with loss of direct formatting, character styles on top of paragraph styles, etc.

    But in general, it's going to work for you. You didn't post the StripStyleKeepFormatting function, but that should also stay as it was, I believe.
    Hi my friend Frosty, the code didn't work, but I appreciated your help. I'D also like to say that I wasn't cross-posting once the address provided is not a thread created by myself. Actually it's just a similar one that I found created for somebody else. I just thought it would be helpfull as a sample. The etiquette u provided me tells it is not good s person whom opens lots of threads to try to get a faster answer, so it did not applies to me for the reason above. Now, I really could provided the address between URL URL code, I just didint because I use to copy and past at my office because the server blocks links.

    Regards

  7. #7
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,710
    Location
    Hi. Frosty was not pointing anything at you. The reference to cross-posting is part of his standard signature.

  8. #8
    Quote Originally Posted by fumei
    Hi. Frosty was not pointing anything at you. The reference to cross-posting is part of his standard signature.

    Hi fumei, tks. got you! ...you know, I'm a newbie, lol

  9. #9
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    Yes, what Fumei said -- that was just a standard disclaimer.

    Taking out all of the commented lines of code (apart from the two I think you needed to put back in), your routine should look something like this. When you say it doesn't work -- can you be a little more specific? What didn't work? The code as you originally posted wouldn't have even run-- it would have given you a compile error. At this point, it should at least compile when you first go to run the macro...


    Sub DeleteCharCharStylesKeepFormatting( ) 
        Dim sty As Style 
        Dim i As Integer 
        Dim doc As Document 
        Dim sStyleName As String 
        Dim sStyleReName As String 
        Dim bCharCharFound As Boolean 
    Set doc = ActiveDocument 
    For i = doc.Styles.Count To 1 Step -1 
        Set sty = doc.Styles(i) 
        sStyleName = sty.NameLocal 
        Call StripStyleKeepFormatting(sty, doc) 
        On Error Resume Next 
        sty.Delete 
        Err.Clear 
        On Error GoTo ERR_HANDLER
        Set sty = Nothing 
             Next i
            Exit Sub 
    ERR_HANDLER: 
            MsgBox "An Error has occurred" & vbCr & _ 
            Err.Number & Chr(58) & Chr(32) & Err.Description, _ 
            vbExclamation 
        End Sub
    Last edited by Aussiebear; 04-21-2023 at 11:45 PM. Reason: Adjusted the code tags

  10. #10
    Yes Frosty, thank your for helping
    after that thing with the commas, the next problem emerged
    seems to be in an infinite loop
    I'm stopping the macro after 1 minute running and no result, pressing ctrl + pause break, and when the macro stops, it highlights the line possibly problematic, and it its the line '.execute' inside the block 'With rngResult.Find'.

    I'm gonna put the piece of block and write a comment (STOPS IN THIS LINE) to make it more clear

    Function StripStyleKeepFormatting(ByRef sty As Style, _
        ByRef doc As Document)
        Dim rngToSearch As Range
        Dim rngResult As Range
        Dim f As Font
    Set rngToSearch = doc.Range
        Set rngResult = rngToSearch.Duplicate
    Do
        With rngResult.Find
            .ClearFormatting
            .Style = sty
            .Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Execute                  'STOPS IN THIS LINE 
        End With
        If Not rngResult.Find.Found Then Exit Do
        Set f = rngResult.Font.Duplicate
        With rngResult
            .Font.Reset
            .Font = f
            .MoveStart wdWord
            .End = rngToSearch.End
        End With
        Set f = Nothing
        Loop Until Not rngResult.Find.Found
    End Function
    Last edited by Aussiebear; 04-21-2023 at 11:47 PM. Reason: Adjusted the code tags

  11. #11
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    And now you get into real troubleshooting.

    If your code stops on the Execute line -- you're going to need to find out why. What is the style it is trying to search for? Is that style applied anywhere in the document?

    And we may need to back up a bit and have you answer an earlier question: why do you want to do this in the first place?

    I guarantee you the problem at this point is not a coding problem, but rather something particular about your setup and the documents you are running on (for example, the original code would *only* run this formatting on Character styles -- since you are now running it on "all" styles - including table styles, list styles and paragraph styles -- you may need to have it adjust further).

    Since I'm not going to throw code at you to see what may or may not work -- you'll need to define why exactly you want to do this.

    And you may want to go do some learning on your own about styles... do you really want to, essentially, take out all formatting in the document *except* for font formatting? Why?

    And if that's what you want to do -- what font formatting do you actually care about retaining? Is it just bold/italic/underline? Superscript? Because it may behoove you to go about this in an entirely different way...

  12. #12
    Frosty, thanks again

    Let me try clarify it:
    My job at the company that I work for, it's to format lots of converted documents daily. These docs are usually converted from scanned pdf to word, and then, they are delivered for translation, but the translator doesn't even care about formatting, instead, they focus on the translation itself.
    After they fineshed their job, they send the files to me so I format it properly.

    The problem is: the conversion messes all the format, for exemple, the paragraphs left and righ idents has small different values throughout the doc, like 1st paragraph having -0,16pt left, and -0,23 right indent., 2nd paragraph -0,03 left, and -0,07 righ, and so on...
    The before and after paragraphs same thing, like: spaceafter having the value 2.37pt, the next paragraph 2.89 pt, and so on.

    and the document has lots of unwanted created styles, and most of them were used, but they are not necessary, what I really wanted is just the bold, itálic, superscript/subscript, underline and to keep just the hard/internal styles.

    If I delete the styles and characteres styles, sometimes I lost the bold, italic, superscript/subscript, underline information, and it takes too long to compare the two version of the docs, to find which words should I put the format back on (bold, italic, etc.)

    The part of the paragraph indent I gave up, I was trying to indent to the 0 value, both right and left indention, but if the paragraphs had an messed up FirstLineIndent, like some paragraphs -0,83, others -0,93, etc... I wanted to format all of them to -0,75, so the paragraphs who had the FirstLineIndent, would have the values: .LeftIndent = CentimetersToPoints(0.75); .FirstLineIndent = CentimetersToPoints(-0.75); and RighIndent = CentimetersToPoints(0.00)

    I know that to put zero value for the left and right indent it's really easy, actually we dont even need a macro for that, ...the difficult part is to check whether it has or not messed FirstLineIndent and then fix it, so I decided to keep doing it mannually.

    Now I was trying to fix the styles and format of the characteres.

    If you have any idea what else should I do, I'll really appreciate.
    tks for the effort and patience

    Regards.
    Ailton

  13. #13
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,710
    Location
    Oh boy.

  14. #14
    Fumei, did I say something wrong?

  15. #15
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    Fumei is just reacting to what a big topic this is -- you're talking about document conversion, which is an entirely different topic really than document cleanup.

    Your approach is to take the converted document (however you've received it) and "cleaning up" some stuff so that it is okay to use for the end-user. That clean up involves getting rid of some paragraph formatting, "bad" styles, but still trying to preserve some document formatting.

    For document conversion, I actually advocate the reverse -- using a "Paste Special Unformatted Text" approach into a "clean new document" shell, and then making sure to restore the stuff that you want to keep (which, in this case, is *some* font formatting)

    I have some massively complicated code which addresses this in a much more robust fashion. But for a couple of reasons (not the least of which is what I'm guessing is your level of expertise in VBA programming), I'm giving you a more simple approach to this. I've included the storing and restoring of the following font attributes: Bold, Italic, *single* underline, superscript and subscript (beware of these two, as often scanned documents will show text as superscript and subscript when it's really just the scan being slightly out of alignment.

    This may help you on your way... although it is still pretty complex code for a beginner.


    ' Main routine -- works on the active document, and leaves you with a new document in which
    ' the main font formatting is restored.
    ' NOTE: if not used in Word 2010, you may need to do multiple "undo" actions to restore your
    ' document to the way it was -- so TEST a lot
    
    Sub ConversionWithFontFormatRestoration()
        Dim oOrigDoc As Document
        Dim oNewDoc As Document
        Dim rngOrigSelection As Range
    Set oOrigDoc = ActiveDocument
        Set oNewDoc = Documents.Add(Visible:=False)
    'mark the formatting
        FontFormat_MarkAll oOrigDoc
    'note, this can pull over section breaks, etc
        oOrigDoc.Content.Copy
        'if we were able to use the undo record, undo the marks (comment out to see the process)
        #If VBA7 Then
        'store the selection
        Set rngOrigSelection = Selection.Range.Duplicate
        'undo (which selects the whole document_
        oOrigDoc.Undo
        'restore the selection
        rngOrigSelection.Select
        #End If
    oNewDoc.Content.PasteSpecial dataType:=wdPasteText
    'replace the formatting
        FontFormat_ReplaceAll oNewDoc
    'make it visible
        oNewDoc.ActiveWindow.Visible = True
    End Sub
    ' Mark all font formats desired

    Sub FontFormat_MarkAll(oDoc As Document)
        Dim oFont As Font
        'make use of the undo record, if it's available
        #If VBA7 Then
        Application.UndoRecord.StartCustomRecord "Mark Font Formatting"
        #End If
    'setting to new clears out all other settings, so you're only searching for a single item
        Set oFont = New Font
        oFont.Bold = True
        FontFormat_Mark oFont, "Bold", oDoc.Content
    Set oFont = New Font
        oFont.Italic = True
        FontFormat_Mark oFont, "Italic", oDoc.Content
    Set oFont = New Font
        oFont.Underline = wdUnderlineSingle
        FontFormat_Mark oFont, "UnderlineSingle", oDoc.Content
    Set oFont = New Font
        oFont.Superscript = True
        FontFormat_Mark oFont, "Superscript", oDoc.Content
    Set oFont = New Font
        oFont.Subscript = True
        FontFormat_Mark oFont, "Subscript", oDoc.Content
    'if we made use of it with the conditional compile, end it
        '(this gives one undo, rather than a bunch)
        #If VBA7 Then
        Application.UndoRecord.EndCustomRecord
        #End If
    End Sub
    ' mark an individual font format

    Sub FontFormat_Mark(oFont As Font, sIdentifier As String, rngSearch As Range)
        With rngSearch.Find
        'just setting the font object doesn't work - so you'd have to do this for each item you care about
        With .Font
            .Bold = oFont.Bold
            .Italic = oFont.Italic
            .Underline = oFont.Underline
            .Superscript = oFont.Superscript
            .Subscript = oFont.Subscript
        End With
        .Replacement.text = "[StartMy" & sIdentifier & "]^&[EndMy" & sIdentifier & "]"
        .Execute Replace:=wdReplaceAll
        End With
    End Sub
    ' Replace all font formats

    Sub FontFormat_ReplaceAll(oDoc As Document)
        Dim oFont As Font
        'make use of the undo record, if it's available
        #If VBA7 Then
        Application.UndoRecord.StartCustomRecord "Replace Font Formatting"
        #End If
        'setting to new clears out all other settings, so you're only searching for a single item
        Set oFont = New Font
        oFont.Bold = True
        FontFormat_Replace oFont, "Bold", oDoc.Content
    Set oFont = New Font
        oFont.Italic = True
        FontFormat_Replace oFont, "Italic", oDoc.Content
    Set oFont = New Font
        oFont.Underline = wdUnderlineSingle
        FontFormat_Replace oFont, "UnderlineSingle", oDoc.Content
    Set oFont = New Font
        oFont.Superscript = True
        FontFormat_Replace oFont, "Superscript", oDoc.Content
    Set oFont = New Font
        oFont.Subscript = True
        FontFormat_Replace oFont, "Subscript", oDoc.Content
    'if we made use of it with the conditional compile, end it
        '(this gives one undo, rather than a bunch)
        #If VBA7 Then
        Application.UndoRecord.EndCustomRecord
        #End If
    End Sub
    ' Replace an indivdual font format

    Sub FontFormat_Replace(oFont As Font, sIdentifier As String, rngSearch As Range)
        With rngSearch.Duplicate.Find
        'have to use wild card searches
        .MatchWildcards = True
        'use the slashes to identify the brackets as real brackets
        'not wildcard search special characters
        .text = "\[StartMy" & sIdentifier & "\]*\[EndMy" & sIdentifier & "\]"
        'set up the formatting replacements
        With .Replacement.Font
            .Bold = oFont.Bold
            .Italic = oFont.Italic
            .Underline = oFont.Underline
            .Superscript = oFont.Superscript
            .Subscript = oFont.Subscript
        End With
        'replace the formatting
        .Execute Replace:=wdReplaceAll
        'remove the start and end markers by
        'resetting the formatting
        .ClearFormatting
        .Replacement.ClearFormatting
        'turning off wildcard searches
        .MatchWildcards = False
        'and removing the specific text
        .text = "[StartMy" & sIdentifier & "]"
        .Replacement.text = ""
        .Execute Replace:=wdReplaceAll
        'and the end codes
        .text = "[EndMy" & sIdentifier & "]"
        .Execute Replace:=wdReplaceAll
        End With
    End Sub
    Last edited by Aussiebear; 04-21-2023 at 11:55 PM. Reason: Adjusted the code tags

  16. #16
    VBAX Master
    Joined
    Feb 2011
    Posts
    1,480
    Location
    And, by the way, this can get as complex and robust as you want it to as you add more format characteristics you want to retain (like some paragraph indents but not all, etc).

    The things to watch out for are the following:

    1. Your format "indicators" (I've used "[StartMyBold]" and "[EndMyBold]" -- in my "real" code which does this, I use very long text strings which are never likely to be in a document, with case-sensitive searching, so that I don't get any false positives when find/replacing formatting -- so my "start format" characters look something like "**[StArTxYzzY1253c235BOLD241824xyYXYasd23]**"

    2. The code creates a new document -- which will be based on your Normal template. If your Normal template has a bunch of custom styles in it... then you're going to get those custom styles in every document created by this process. So you can either create a new document on a different template (something specific to the document shell you want these resultant documents to start from), or you're going to need to make that part of the code more robust, or you're going to need to delete your normal template to get a "clean" one.

    3. Wildcard searching -- because of the need to use Wildcard searching in the format replacement area, I have to use special characters in a wildcard search which don't need to exist in the original search. Be careful making modifications to these find and replace strings without reading up on proper wildcard searches. It will help a lot to just try doing regular wildcard searches (not replacing anything) to see what the text actually needs to be.

    I'm on vacation soon, so if I don't respond again for some time... hopefully someone else can pick up the torch.

    - Frosty aka Jason

  17. #17
    JAson, tks a lot, i'm gonna try to understand the code and I'll give you a feedback soon. Have a good vacation.
    Regards.
    Ailton

  18. #18
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,710
    Location
    Frosty (Jason) knows me too well. I was indeed reacting to the massiveness of the topic.

    As you can see from Jason's sample code, this can be a VERY complex operation. There are so many variables to deal with.

    BTW, I agree with Jason regarding document conversion. The amount of work involved in order to retain SOME format is simply not worth it. I bring in content unformatted and apply the formats I want. Virtually all formats that I need I have as keyboard shortcuts. So it is WAY faster for me to apply formats than to "fix" formats.

    Good luck. I look forward to seeing what you come up with.

  19. #19
    yes Fumei, thank you.
    I'm not a native English speaker, so sometimes I don't understand the English in first place. So you can imagine how things are more difficult for my understanding.

    I really appreciated your words, and I'd like to say, that is visible you guys are experts. I'm just a learner

    Now one thing that I cannot understand is: how you guys can consider to be faster, to manually put bold, italic and underline itens back on thousands of pages everyday.

    Especifically on my case (working with two monitor), I have to look to both monitors, where the original document is located in one of them, inspect it searching for bold, italic, underline itens, then go to the other monitor and, for instance, put the bold format exactly in the same word, which is not located in the same page position as the original document, because remember, in one hand, we have a not formatted document, and in the other hand, a document full of format information, like space and after paragraphs, different font sizes, and so on, etc... Add to it, a foreing language, maybe German or Chinese, now try to memorize a bold Chinese word in the original document, and quickly go to the other monitor, to scroll the document searching for the same word until you find it, then finally applies the format.

    About shortcuts, I already use lots, really lots of them.
    Last edited by ayltonasc; 07-11-2013 at 04:49 PM.

  20. #20
    Now, if you guys are trying to say that this duplicate doc method, extracting just the bold, italic, and underline format from the first document, and then to reformat just the rest of other format information it's easier, I agree, cause it's exactly what I was looking for (a doc with bold, italic, and underline, superscript, etc... information) and the rest I reformat with no problems at all

    BTW, Tks a lot Fumei, I've just tried the macro you've created and it's works like a charm!!!
    I thought it would take days to make it usefull, but for my suprise, it worked since the first try.

    FINALLY SOLVED
    Tks for the patience, Jason and Fumei

Posting Permissions

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