Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Nov 2012
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Angry Function/Sub to pass a font attribute?

    Hello,

    I have a macro that looks for direct formatting such as bold, intalics, highlighting, superscript, and subscript. I want to create a function or procedure that I can pass the font attribute to apply (or not) to a Word or character. Writing a sub for each attribute seems to be a bloat of code.

    Here is what I have now. The declaration of objAttribute is causing an error. Can this be done? Any help is appreciated, thanks.
    Code:
    Private Function doNewSuperscript(ByRef rngParaOld As Range, ByRef rngParaNew As Range, ByVal objAttribute As ?) 
        Dim iWord As Integer 
        Dim iChar As Integer 
        Dim iSuper As Long 
        iSuper = rngParaOld.Font.objAttribute 
        Select Case iSuper 
        Case 9999999 
            For iWord = 1 To rngParaOld.Words.Count 
                iSuper = rngParaOld.Words(iWord).Font.objAttribute 
                If iSuper = 9999999 Then 'a character in the word is "attribute"
                    For iChar = 1 To rngParaOld.Words(iWord).Characters.Count 'look at each character in word
                        iSuper = rngParaOld.Words(iWord).Characters(iChar).Font.obj Attribute 
                        rngParaNew.Words(iWord).Characters(iChar).Font.obj Attribute = iSuper 
                        StatusBar = "Applying Superscript..." 
                    Next iChar 
                ElseIf iSuper = 0 Then 
                    rngParaNew.Words(iWord).Font.objAttribute = 0 
                    StatusBar = "Applying Superscript..." 
                ElseIf iSuper = -1 Then 
                    rngParaNew.Words(iWord).Font.objAttribute = -1 
                End If 
            Next 
        Case 0 
            rngParaNew.Font.objAttribute = 0 
        Case -1 
            rngParaNew.Font.objAttribute = -1 
        End Select 
    End Function
    Last edited by macropod; 2012-11-03 at 15:41. Reason: Added code tags & formatting

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,889
    Thanks
    0
    Thanked 188 Times in 172 Posts
    You will need to test each attribute. However, a character-based test will be unduly slow. You'll find that using Find/Replace is far faster, as it can find any number of characters with a given attribute at a time. That said, I'm not sure what you're aiming to achieve that can't be achieved via a copy/paste process rather than the format replication approach you're now taking.

    PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  4. #3
    Star Lounger
    Join Date
    Jan 2003
    Location
    San Francisco, California, USA
    Posts
    88
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Hi Paul, thanks for the response. I'm finding with the move from 2003 to 2007 (Word) that the best way to remove corruption is to paste a document as unformatted text. This macro is only one of many subs that reapply formatting. It is fairly fast. What I was hoping is to look to see if the user checked to retain Super scripting formatting (direct formatting) and if so go para by para, word by word, or character by character. Our documents have a lot of subscript and superscript. Idealy this sub would do:

    1. Check to see if chkBold on form is true
    2. If so go to sub below, and reapply the formatting.

    The code above is identical for every attribute - bold, italics, color, etc. and I was hoping to pass the font attribute to the sub below to reduce code. Hope this makes sense.
    Last edited by ajulyguy; 2012-11-04 at 13:52.

  5. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,889
    Thanks
    0
    Thanked 188 Times in 172 Posts
    I think you'll find that corruption can be removed quite simply by the old method:
    1. insert a new paragraph at the end of the document
    2. copy & paste everything except that new paragraph to a new document.
    That way all formatting, except perhaps the page layout of the last Section, is retained. Graphics, footnotes, bookmarks, fields, etc are are retained. As a rule, the only corruption that isn't fixed this way is that of corrupt tables. They can be fixed by converting to text and back.

    AFAIK, as there is no attributes collection for a font, you can't pass a member of the non-collection as an argument.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  6. #5
    Star Lounger
    Join Date
    Jan 2003
    Location
    San Francisco, California, USA
    Posts
    88
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Hi Paul, thanks for the information. Unfortunately, i need this macro to fix all those corrupted tables. Does Microsoft have a conversion tool?

  7. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,889
    Thanks
    0
    Thanked 188 Times in 172 Posts
    A basic 'table repair' sub is:
    Code:
    Sub TableRepair()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, Rng As Range, strTblSty As String, strCellSty As String
    With ActiveDocument
      For i = .Tables.Count To 1 Step -1
        strTblSty = "": strCellSty = ""
        With .Tables(i)
          If Not .Style Is Nothing Then strTblSty = .Style
          With .Range
            For j = 1 To .Paragraphs.Count
              strCellSty = strCellSty & "," & .Paragraphs(j).Style
            Next
            With .Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Format = False
              .Wrap = wdFindStop
              .Text = "^p"
              .Replacement.Text = Chr(182)
              .Execute Replace:=wdReplaceAll
            End With
          End With
          Set Rng = .Range
          .ConvertToText
        End With
        Rng.ConvertToTable
        With Rng.Tables(1)
          If strTblSty <> "" Then .Style = strTblSty
          With .Range
            With .Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Format = False
              .Wrap = wdFindStop
              .Text = Chr(182)
              .Replacement.Text = "^p"
              .Execute Replace:=wdReplaceAll
            End With
            For j = 1 To .Paragraphs.Count
              .Paragraphs(j).Style = Split(strCellSty, ",")(j)
            Next
          End With
        End With
      Next
    End With
    Application.ScreenUpdating = True
    End Sub
    You'll lose paragraph-level hard formatting that overrides the underlying Style definition, but you shouldn't really have that anyway (Styles should be used). Character-level hard formatting (and character Styles) will be preserved, however.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

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