VBA Word code to find a border around text.

JohnRobinAllen
JohnRobinAllen used Ask the Experts™
on
I would like to find a way that I can make VBA search a Word document for text that has a border around it. Any suggestions? See attached sample.
     I suspect the solution is not simple.
     Thanks for any suggestions.
           -- j.r.a.
Border-problem.doc
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Chris BottomleySoftware Quality Lead Engineer
Top Expert 2011

Commented:
First stab:

CHris
Sub getBord()
Dim wrd As Object
Dim bord As Integer
Dim intBord As Integer

    For Each wrd In ThisDocument.Words
        bord = 0
        For intBord = 1 To wrd.Borders.Count
            If wrd.Borders(intBord).Visible Then bord = bord + 1
        Next
        If bord = 4 Then Stop
    Next
End Sub

Open in new window

JohnRobinAllenRetired professor of French

Author

Commented:
 
Chris's suggestion is a great beginning. I have a couple of queries to help me improve on the code:  
     1. Since I know that a border at the top of a word will mark a word with four borders, is there any way I can check for just that one border at the top? Failing that, I can simply check for a single border. For my problem, I know in advance that any words with borders will have all four borders.  
     2. Very few of the texts on which I will use the routine will have any borders around words. It will probably be less than one percent of the texts examined. Is there any way I can quickly check that, for a given selected text, there is a word with a border at the top without going through each word? If that check then shows there is a border somewhere, then I can go through each word and locate where there are borders.  
     Eventually, I want this to recognize borders that surround two or more adjacent words, and I can handle that myself. When written, I will post the code with EE, with full credit going to Chris. If I finish the code before we get an answer to the second query, I will post it and later revise it in light of any comments Chris wants to make.  
     Chris has done the heavy lifting toward solving this problem, and I am grateful.  
     
     --j.r.a.  
Software Quality Lead Engineer
Top Expert 2011
Commented:
Something like this?

Chris
Sub getBord()
Dim wrd As Object

    For Each wrd In ThisDocument.Words
        If wrd.Borders(wdBorderTop).Visible Then MsgBox "Do Something with " & wrd
    Next
End Sub

Open in new window

Why Diversity in Tech Matters

Kesha Williams, certified professional and software developer, explores the imbalance of diversity in the world of technology -- especially when it comes to hiring women. She showcases ways she's making a difference through the Colors of STEM program.

Chris BottomleySoftware Quality Lead Engineer
Top Expert 2011

Commented:
In respect of establishing any word with borders then I don't think it will be possible based off the manner in which it is recorded.

Chris
JohnRobinAllenRetired professor of French

Author

Commented:
 
       The attached sub goes through the current selection to look for text with a border around it. It stores the location of each text in the selection with such a border. My thanks to Chris Bottomley for his help in providing the function that recognizes whether a selected text has at least one border. The sub assumes that if there is one border, then there must be all four borders.  
       As explained in the comments, if one knows in advance that borders are never applied to single characters within a word, then one can speed up the function by having it jump through the selection by word rather than by character.
       Full credit goes to Chris Bottomley, without whose help I would not have been able to write this function.
       j.r.a.

Sub Findborders()
'     Sub adapted by J.R. Allen from code written by Chris Bottomley
'     This stores the location of borders that surround letters or words in the current selection, i.e.,
'     the starting point and ending point of borders. If one then applies a different character style
'     to the selection, that removes the borders, but another sub (not shown here) then uses the
'     stored locations to reformat the text to restore the former borders around words or letters.

'     The routine shown here handles only the borders, the locations of which are stored in the string
'     array strTextTracker(). However, since that array also holds the locations of other formatting
'     to be applied later (formatting such as italicized, underscored, or bold characters), each entry
'     in the array contains three items, separated by a carriage return (vbCr): the starting and ending
'     points of each formatted text and the type of formatting we subsequently apply to the text
'     between those two locations.

'     Two other subs not supplied here are (a) a sub to go through the selected text and locate
'     other formatting to store in the strTextTracker array and (b) a sub to use the information in
'     that array to reapply the formatting instructions stored in the array.

'     The code below moves through the selection by character, but if one knows in advance that borders
'     will be around whole words rather than individual characters, one can speed the process by changing
'     the code below to skip through the current selection by words.

Dim FormatType As String
Dim SelectionStart As Integer
Dim SelectionEnd As Integer
Dim BorderStart As Integer
Dim BorderEnd As Integer
ReDim strTextTracker(0) As String

      '     Note the coordinates of the current selection.
      SelectionStart = Selection.Start
      SelectionEnd = Selection.End
      
      '     Look for any borders around letters in the selection.
      FormatType = "Borders"  '     The 1st of three items to store (possibly) in the strTextTracker() array
      With Selection
            .Collapse wdCollapseStart                    '     go to start of selection
            Do While .Start < SelectionEnd
                  .MoveRight wdCharacter, Extend:=wdExtend
                  If .Borders(1).Visible = True Then
                        '     The current selection has a border. Note where it starts
                        BorderStart = .Start
                        '     See where the border ends
                        .Collapse wdCollapseEnd
                        Do While .Start <= SelectionEnd
                              .MoveRight wdCharacter, Extend:=wdExtend
                              If .Borders(1).Visible = False Then
                                    '     We have reached the end of the text with a border around it. Note location
                                    BorderEnd = Selection.Start
                                    '     Store the 3 pieces of info in the string array
                                    strTextTracker(UBound(strTextTracker)) = BorderStart & vbCr & BorderEnd & vbCr & FormatType
                                    ReDim Preserve strTextTracker(UBound(strTextTracker) + 1)
                                    Exit Do     '     Get out of this inner loop and look for another border
                              End If
                              .Collapse wdCollapseEnd
                        Loop
                  End If
                  .Collapse wdCollapseEnd
            Loop
      End With
      '     We reached the end of the current selection. Select again what we had selected before we started this sub
      ActiveDocument.Range(SelectionStart, SelectionEnd).Select
End Sub

Open in new window

JohnRobinAllenRetired professor of French

Author

Commented:
I revised the code here to make a sub that stores in an array the location of any text with borders that exists within the current selection. See the code snippet in my comment below.
      j.r.a.
Chris BottomleySoftware Quality Lead Engineer
Top Expert 2011

Commented:
Nicely ttidied up into a function.

Chris
JohnRobinAllenRetired professor of French

Author

Commented:
I should have put the strTextTracker()  as an argument to the sub. If anyone wants the two related functions (a) a function to look for the location of other formatting to store in strTextTracker, and (b) a function to restore the formatting stored in strTextTracker, let me know and I will add them here.

In my own work, I found that I used borders around text so rarely and the routine to check for that took so long that I removed the borders and replaced them with underlined italics. That sort of formatting is easier to detect in VBA code.

I certainly appreciated learning how to use .borders in my code;
      --John Robin

Commented:
Yes please - I'd like to see the 2 functions!

Cheers, Steve

Commented:
Changed ThisDocument to ActiveDocument and all works

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial