Find tables by using Word macro
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Find tables by using Word macro
Hi,
I've a document that contains too many tables (50-100). Some table rows have cell shading. But few tables haven't any shading color. Entire document have only one shading RGB color.
I need to find only shading applied tables (Ignore other tables) and run a macro for each tables. Any easy way to do that?
Thanks!
I've a document that contains too many tables (50-100). Some table rows have cell shading. But few tables haven't any shading color. Entire document have only one shading RGB color.
I need to find only shading applied tables (Ignore other tables) and run a macro for each tables. Any easy way to do that?
Thanks!
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
You could use a macro like this:
Code: Select all
Sub ShadedTables()
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
If tbl.Shading.BackgroundPatternColor <> wdColorAutomatic Then
tbl.Select
' Run your macro here. It can act on the selected table.
Call MyMacro
End If
Next tbl
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Hi Hans,
Wow It's amazing. I'll customize this per my requirements.
Wow It's amazing. I'll customize this per my requirements.
-Sampath-
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Another scenario is some tables split into multiple pages (No repeat header rows enabled any table). Any option to find those tables?
Thanks!
Thanks!
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
Like this:
Code: Select all
Sub DetectSplitTables()
Dim tbl As Table
Dim lngStart As Long
Dim lngEnd As Long
For Each tbl In ActiveDocument.Tables
lngStart = tbl.Range.Start
lngEnd = tbl.Range.End - 1 ' Subtract 1 because .Range.End is below the table.
If ActiveDocument.Range(lngStart, lngStart).Information(wdActiveEndPageNumber) < _
ActiveDocument.Range(lngEnd, lngEnd).Information(wdActiveEndPageNumber) Then
tbl.Select
Call MyMacro
End If
Next tbl
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
I just trying to select shading included first cell to bottom cell. (See below attached image.)HansV wrote:You could use a macro like this:
Code: Select all
Sub ShadedTables() Dim tbl As Table For Each tbl In ActiveDocument.Tables If tbl.Shading.BackgroundPatternColor <> wdColorAutomatic Then tbl.Select ' Run your macro here. It can act on the selected table. Call MyMacro End If Next tbl End Sub
But something went wrong. And I've no Idea about how to select those cells except entire column.
Code: Select all
Private Sub SelectTable()
Dim c As Cell
For Each c In ActiveDocument.Range.Cells
If c.Shading.BackgroundPatternColor <> wdColorAutomatic Then
c.Select
End If
Next c
End Sub
You do not have the required permissions to view the files attached to this post.
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
Did you get an error message? If so, what did it say?
(I'll be away for some hours with limited access to a computer, so I won't be able to reply immediately).
(I'll be away for some hours with limited access to a computer, so I won't be able to reply immediately).
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Hi Hans,
I didn't get any error massages. But above mentioned code will select the first cell of the table. My target is select cells as above screen-shot.
Thanks for the quick responses. take your time and response back... Thanks!
I didn't get any error massages. But above mentioned code will select the first cell of the table. My target is select cells as above screen-shot.
Thanks for the quick responses. take your time and response back... Thanks!
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
You can check whether the cell is in the first column by checking
You can perform an action on each cell as it is selected, for example run a macro, or change the font color of the cell, or make the text bold, or whatever. If you merely loop through the cells and only select each cell in turn, nothing useful will happen.
Code: Select all
If cel.ColumnIndex = 1 Then
...
End If
Best wishes,
Hans
Hans
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Find tables by using Word macro
How about:
Code: Select all
Sub SelectFirstColumn()
Dim rng As Range
If Selection.Information(wdWithInTable) Then
Set rng = Selection.Tables(1).Cell(2, 1).Range
rng.Collapse Direction:=wdCollapseStart
rng.Select
Selection.EndKey Unit:=wdColumn, Extend:=True
End If
End Sub
Regards,
Rudi
If your absence does not affect them, your presence didn't matter.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Hi Hans,
Thanks now 80% done in my expectation
But I've no idea about how to select first cell of the table. First cell means shading included first cell of the table. See below image for more clarity.
Final goal is add leader dots into the selected cells (Except table captions).
Earlier my request is select shading included table and then select first column of the table. But I've no option to ignore table captions. That's why I'm again change my concept. Thanks for helping!
Thanks now 80% done in my expectation
![ThankYou :thankyou:](./images/smilies/thankyou.gif)
But I've no idea about how to select first cell of the table. First cell means shading included first cell of the table. See below image for more clarity.
Final goal is add leader dots into the selected cells (Except table captions).
Earlier my request is select shading included table and then select first column of the table. But I've no option to ignore table captions. That's why I'm again change my concept. Thanks for helping!
You do not have the required permissions to view the files attached to this post.
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
Does this do what you want? Please test it thoroughly!
Code: Select all
Sub Testing()
Dim tbl As Table
Dim r As Long
Dim w As Single
Application.ScreenUpdating = False
For Each tbl In ActiveDocument.Tables
If tbl.Cell(2, 1).Shading.BackgroundPatternColor <> wdColorAutomatic Then
For r = 2 To tbl.Rows.Count
With tbl.Cell(r, 1)
w = .Width - .LeftPadding - .RightPadding
With .Range
With .ParagraphFormat.TabStops
.ClearAll
.Add Position:=w, Leader:=wdTabLeaderDots
End With
.InsertAfter Text:=vbTab
End With
End With
Next r
End If
Next tbl
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Yes it's works for some tables. But in my some table captions goes to more than 1 row. That's why I've to find shading included first cell of the table. Any way to do that?
Thanks!
Thanks!
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
The requirements keep changing all the time!
Code: Select all
Sub Testing()
Dim tbl As Table
Dim f As Boolean
Dim r1 As Long
Dim r As Long
Dim w As Single
Application.ScreenUpdating = False
For Each tbl In ActiveDocument.Tables
f = False
For r1 = 1 To tbl.Rows.Count
If tbl.Cell(r1, 1).Shading.BackgroundPatternColor <> wdColorAutomatic Then
f = True
Exit For
End If
Next r1
If f Then
For r = r1 To tbl.Rows.Count
With tbl.Cell(r, 1)
w = .Width - .LeftPadding - .RightPadding
With .Range
With .ParagraphFormat.TabStops
.ClearAll
.Add Position:=w, Leader:=wdTabLeaderDots
End With
.InsertAfter Text:=vbTab
End With
End With
Next r
End If
Next tbl
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Hi Hans,
Thanks, That code works for some documents. But in my document types not works properly. I've no idea about what's the reason for that.. Here with I've attached a sample document for your reference. And also my dot leaders adding macro is complex. It'll ignore (:) colon characters and blank cells while adding the dot leaders.
Thanks, That code works for some documents. But in my document types not works properly. I've no idea about what's the reason for that.. Here with I've attached a sample document for your reference. And also my dot leaders adding macro is complex. It'll ignore (:) colon characters and blank cells while adding the dot leaders.
Code: Select all
Private Sub Add_DotLeaders()
Const aCOLON = 58
Const aRETURN = 13
Const aTAB = 9
Const aCELLFORMAT = 7
Dim Tabvalue As Integer
Dim x As Integer
Dim CompChar As String
Dim tstring As String
Dim c As Cell
For Each c In Selection.Cells
Tabvalue = c.Width - c.RightPadding
With c.Range.ParagraphFormat.TabStops
.ClearAll
.Add Position:=Tabvalue, Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots
End With
With c.Range
tstring = .Text
If Len(Trim(tstring)) > 2 Then
For x = Len(.Text) - 1 To 1 Step -1
CompChar = Mid(tstring, x, 1)
Select Case (CompChar)
Case Chr(aCOLON)
Exit For
Case Chr(aRETURN)
If Len(tstring) > 1 Then
tstring = Left(tstring, Len(tstring) - 1)
End If
Case Chr(aCELLFORMAT)
If Len(tstring) > 1 Then
tstring = Left(tstring, Len(tstring) - 1)
End If
Case Else 'Stop loop when found char other then 7, 13, 58 is found
.InsertAfter (Chr(9))
Exit For
End Select
Next
End If
End With
Next c
End Sub
You do not have the required permissions to view the files attached to this post.
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
In your sample document, the shading of the cells in row 1 is not automatic, but white. Do you want to exclude white as well as automatic?
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Ah.. That's the case. Yes please can you ignore both white and automatic?
And I've to link my dot leader adding macro to that code. I know it's crazy
Thanks for helping!
And I've to link my dot leader adding macro to that code. I know it's crazy
![HairOut :hairout:](./images/smilies/hairout.gif)
Thanks for helping!
-Sampath-
-
- Administrator
- Posts: 78920
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find tables by using Word macro
Here you go:
Code: Select all
Sub Testing()
Dim tbl As Table
Dim f As Boolean
Dim r1 As Long
Dim r As Long
Dim w As Single
Application.ScreenUpdating = False
For Each tbl In ActiveDocument.Tables
f = False
For r1 = 1 To tbl.Rows.Count
Select Case tbl.Cell(r1, 1).Shading.BackgroundPatternColor
Case wdColorAutomatic, wdColorWhite
' Skip these
Case Else
f = True
Exit For
End Select
Next r1
If f Then
For r = r1 To tbl.Rows.Count
tbl.Cell(r, 1).Select
Call Add_DotLeaders
Next r
End If
Next tbl
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 318
- Joined: 23 Aug 2016, 07:43
- Location: Sri Lanka
Re: Find tables by using Word macro
Thank you Hans,
Now It's works well. That's the ultimate goal.
Additionally I think this macro can speed-up by using this code to select all cells. I think currently it's run cell by cell. So, may I know which parts of code should I edit to do that?
Now It's works well. That's the ultimate goal.
Additionally I think this macro can speed-up by using this code to select all cells. I think currently it's run cell by cell. So, may I know which parts of code should I edit to do that?
Code: Select all
Selection.EndKey Unit:=wdColumn, Extend:=True
-Sampath-