Solved

I need a macro to search text, in table cells only, of a particular style!

Posted on 2013-12-17
10
137 Views
Last Modified: 2015-02-06
Greetings experts!
I'm reaching out to you for help with another bit of code that I just can't figure out.

I have a Chinese document in Word where the last line of EVERY paragraph must have more than one character besides punctuation. I have written a macro to search for all paragraph marks of a number of styles, move left three characters, and insert a zero-width, non-breaking character. This works great on all content except for paragraphs inside tables since there aren't paragraph marks (unless there are more than one paragraph) and you can't search for the "end of table cell" mark.

We use tables (typically 2-column) in our documents to help format text & associated graphics (instead of using inline graphics). We have a graphic in the left column and text in the right column, or the other way around. We use one of 7 different styles for the text in the table cells (i.e., Body Text, Table Text, etc.).

I need to search just tables for certain styles and do the same thing I've done with the aforementioned macro.

Here's the macro solution that works for all the content not in tables. If this can be modified to include the table content, I'd love the help. If not, how do I search just tables to do this?

Option Explicit

Sub InsertZeroWidthSpace()

Dim rng As Range
Dim i As Long

    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:="5"
    
    For i = 1 To 19
        Set rng = ActiveDocument.Range
        With rng.Find
            .ClearFormatting
            .Text = "^p"
            .Style = Choose(i, "Body Text", "Body Text - After Table", "List Bullet Checkmark", "Body Text 2 - PreNumbered", _
                "Body Text Indent", "List Bullet Box", "Table Text L - Parts", "Step", "Step Text", "Table Text L - 9 pt", _
                "Legend List", "List", "List Continue", "Legend List Bullet Indent", "List Bullet Box Indent", _
                "Step Result", "Caution Bullet", "Body Text - PreNumbered", "Legend List Continue")
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
 
        While rng.Find.Execute
            rng.Select
            Selection.MoveLeft Unit:=wdCharacter, Count:=3
            Selection.InsertSymbol CharacterNumber:=8205, Unicode:=True, Bias:=0
        Wend
        
        End With
    Next i
    
End Sub

Open in new window


If anyone out there has a solution or suggestions, I'll give you the max points possible!! HELP!

Thanks so much in advance.
Jan
0
Comment
Question by:jbarcher13
  • 4
  • 2
  • 2
  • +1
10 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39724361
Hi,

pls try

Option Explicit

Sub InsertZeroWidthSpace()

Dim rng As Range
Dim i As Long

    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:="5"
    
    For i = 1 To 19
        Set rng = ActiveDocument.Range
        Call SearchAndInsert(rng, i)
        For Each tbl In ActiveDocument.Tables
            For Each rw In tbl.Rows
                For Each c In rw.Cells
                    Set rng = c.Range
                    Call SearchAndInsert(rng, i)
                Next
            Next
        Next
    Next i
    
End Sub

Sub SearchAndInsert(ByVal rng As Range, ByVal i As Integer)
        With rng.Find
            .ClearFormatting
            .Text = "^p"
            .Style = Choose(i, "Body Text - After Table", "List Bullet Checkmark", "Body Text 2 - PreNumbered", _
                "Body Text Indent", "List Bullet Box", "Table Text L - Parts", "Step", "Step Text", "Table Text L - 9 pt", _
                "Legend List", "List", "List Continue", "Legend List Bullet Indent", "List Bullet Box Indent", _
                "Step Result", "Caution Bullet", "Body Text - PreNumbered", "Legend List Continue")
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
 
        While rng.Find.Execute
            rng.Select
            Selection.MoveLeft Unit:=wdCharacter, Count:=3
            Selection.InsertSymbol CharacterNumber:=8205, Unicode:=True, Bias:=0
        Wend
        End With
End Sub

Open in new window

Regards
0
 

Author Comment

by:jbarcher13
ID: 39724415
Hi! Thanks for getting back to me so quickly. I've tried the code and I'm getting this error message:

Error 5991:
Cannot access individual rows in this collection because the table has vertically merged cells.

I also noticed that "rw" "c" and "tbl" were not declared. Here's the code now:

Option Explicit

Sub InsertZeroWidthSpace()

Dim rng As Range
Dim i As Long
Dim tbl As Table
Dim rw As Row
Dim c As Cell

    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:="5"
    
    For i = 1 To 19
        Set rng = ActiveDocument.Range
        Call SearchAndInsert(rng, i)
        For Each tbl In ActiveDocument.Tables
            For Each rw In tbl.Rows
                For Each c In rw.Cells
                    Set rng = c.Range
                    Call SearchAndInsert(rng, i)
                Next
            Next
        Next
    Next i
    
End Sub

Sub SearchAndInsert(ByVal rng As Range, ByVal i As Integer)
        With rng.Find
            .ClearFormatting
            .Text = "^p"
            .Style = Choose(i, "Body Text - After Table", "List Bullet Checkmark", "Body Text 2 - PreNumbered", _
                "Body Text Indent", "List Bullet Box", "Table Text L - Parts", "Step", "Step Text", "Table Text L - 9 pt", _
                "Legend List", "List", "List Continue", "Legend List Bullet Indent", "List Bullet Box Indent", _
                "Step Result", "Caution Bullet", "Body Text - PreNumbered", "Legend List Continue")
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
 
        While rng.Find.Execute
            rng.Select
            Selection.MoveLeft Unit:=wdCharacter, Count:=3
            Selection.InsertSymbol CharacterNumber:=8205, Unicode:=True, Bias:=0
        Wend
        End With
End Sub

Open in new window


Is there a way to skip those kind of tables without causing any problems?

Thanks, Jan
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39724550
Hi,

pls try

Sub InsertZeroWidthSpace()

Dim rng As Range
Dim i As Long

    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:="5"
    
    For i = 1 To 19
        Set rng = ActiveDocument.Range
        Call SearchAndInsert(rng, i)
        For Each tbl In ActiveDocument.Tables
            For r = 1 To tbl.Rows.Count
                For c = 1 To tbl.Columns.Count
                    On Error Resume Next
                    Set cl = tbl.Cell(r, c)
                    On Error GoTo 0
                    Set rng = cl.Range
                    If Not (IsEmpty(cl)) Then
                        Call SearchAndInsert(rng, i)
                    End If
                Next
            Next
        Next
    Next i
    
End Sub

Open in new window

Regards
0
 

Author Comment

by:jbarcher13
ID: 39725110
Hi!

Well, I must be doing something wrong. I might be using the incorrect variable declarations for "cl", "c", "tbl", and "r" because I'm getting a Type Mismatch error message when I try to run this. Can you point out the error of my ways, please?

Also, I just noticed in the SearchAndInsert(ByVal rng As Range, ByVal i As Integer) sub, you're still searching for "^p" and there are no paragragph marks in table cells if there is only one paragraph (which happens 98% of the time with my case). Do I need to have this?

Here's what I have:

Option Explicit

Sub InsertZeroWidthSpace()

Dim rng As Range
Dim i As Long
Dim tbl As Table
Dim rw As Row
Dim cl As Cell
Dim r As Row
Dim c As Column
    
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:="5"
    
    For i = 1 To 8
        Set rng = ActiveDocument.Range
        Call SearchAndInsert(rng, i)
        For Each tbl In ActiveDocument.Tables
            For r = 1 To tbl.Rows.Count
                For c = 1 To tbl.Columns.Count
                    On Error Resume Next
                    Set cl = tbl.Cell(r, c)
                    On Error GoTo 0
                    Set rng = cl.Range
                    If Not (IsEmpty(cl)) Then
                        Call SearchAndInsert(rng, i)
                    End If
                Next
            Next
        Next
    Next i
    
End Sub
   
Sub SearchAndInsert(ByVal rng As Range, ByVal i As Integer)
        With rng.Find
            .ClearFormatting
            .Text = "^p"
            .Style = Choose(i, "Body Text", "Table Text L - Parts", "Step", "Table Text L - 9 pt", _
                "List", "List Continue", "Table Text Centered - 8 pt", "Step Result")
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
 
        While rng.Find.Execute
            rng.Select
            Selection.MoveLeft Unit:=wdCharacter, Count:=3
            Selection.InsertSymbol CharacterNumber:=8205, Unicode:=True, Bias:=0
        Wend
        End With
End Sub

Open in new window


Thanks for your help! Jan
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39730932
Can you upload a sample file for testing?
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39731365
Hi,
I think your code is something of an overkill. Yousee, the paragraph mark is the same for all styles. Therefore you don't need to specify any. Also, ActiveDocument.Range includes all sections. Therefore your code would run 16 times, adding 16 characters(8205) in the specified locations.
Because of these observations I have taken a rather different approach. The code appended below isolates the last 3 characters in each paragraph or - in a separate operation - each cell of each table. The last two are one Chinese character, and the first might be the replacement character. If it is, no action will be taken. If not, it is inserted before the last 2 characters.
Sub OrphanControl()

    Dim Fnd As Range
    Dim Tbl As Table
    Dim Cll As Cell
    Dim Rng As Range
    
    Set Fnd = ActiveDocument.Content
    With Fnd.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Chr(13)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .Execute
    End With

    While Fnd.Find.Found
        With Fnd
            If .Paragraphs(1).Range.Characters.Count > 3 Then
                Set Rng = ActiveDocument.Range(Start:=.Start - 3, End:=.Start)
                InsertCharacter Rng
            End If
            .Find.Execute
        End With
    Wend
    
    If ActiveDocument.Tables.Count Then
        For Each Tbl In ActiveDocument.Tables
            For Each Cll In Tbl.Range.Cells
                With Cll.Range
                    If .Characters.Count > 3 Then
                        Set Rng = ActiveDocument.Range(Start:=.End - 4, End:=.End - 1)
                        InsertCharacter Rng
                   End If
                End With
            Next Cll
        Next Tbl
    End If
End Sub

Private Sub InsertCharacter(Rng As Range)
    
    Const NewChar As Long = 8205
    Dim Txt As String
    
    Txt = Rng.Text
    If AscW(Txt) <> NewChar Then
        Txt = Left(Txt, 1) & ChrW(NewChar) & Mid(Txt, 2)
        Rng.Text = Txt
    End If
End Sub

Open in new window

I didn't test the code with Chinese characters and, actually, don't know what might happen if the 4th character from the end is half a character which is being tested. I expect it to be OK, but if this throws an error please do let me know.

I haven't taken final interpunctuation into consideration. If you need to allow, say a full stop, at the end in addition to a single text character please advise the Unicode numbers of the characters you wish to allow and I will adjust my code.
0
 

Accepted Solution

by:
jbarcher13 earned 0 total points
ID: 39732012
I'll try this right away...thanks! Jan
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39733176
It just occurs to me that there might be a problem with cells containing drawings. Characters 8205 might be inserted into them. I would need one sample row of your table, with content, to amend my program not to do its magic on cells that don't contain text.
0
 

Author Closing Comment

by:jbarcher13
ID: 40593224
Very thorough.
0

Featured Post

Free Gift Card with Acronis Backup Purchase!

Backup any data in any location: local and remote systems, physical and virtual servers, private and public clouds, Macs and PCs, tablets and mobile devices, & more! For limited time only, buy any Acronis backup products and get a FREE Amazon/Best Buy gift card worth up to $200!

Join & Write a Comment

This article will show you how to use shortcut menus in the Access run-time environment.
Outlook Free & Paid Tools
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now