#1
|
|||
|
|||
Macro for selecting pages and formatting of tables
a. How can we design the macro to make a selection from one particular page to another particular page?
b. Once selected, do the following in the tables within those pages: i. Delete – All rows including Date. ii. Delete – All rows starting with “age”. iii. Delete – All Zero Rows. iv. Remove all rows with % symbols in them. v. Add $ sign to all the numbers. vi. Replace “>” with “five blank spaces” vii. Spacing of cell – Before 5 pt, After 2 pt. viii. Change the font size to 9. |
#2
|
||||
|
||||
Hi umesh,
Do you want to process all tables, or just a particular table? If it's just a particular table, does the table have any unique content or a bookmark? In what format(s) are the dates? Do you want to match the case for 'age'? Do the zero rows have 0s or are they empty? Your last two steps should be managed by applying an approriate Style to the table, not by hard-formatting its content.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Hi Paul,
I want to process all tables with in that pages range. Dates are in the format 1 Jul 12, 1 Jul 13 etc. For age no I do not want to match the case. Zeros rows have all 0s except in the first cell - which has text. The reason I do not want to manage the last two steps by styles is because of complications in the word document styles. The complication is due to the conversion from Open office to word format. when we do it disables some styles and some features of specific styles of word document. Hope it was clear. |
#4
|
||||
|
||||
Hi umesh,
Try: Code:
Sub FormatTables() Application.ScreenUpdating = False Dim oTbl As Table, oCel As Cell, Rng As Range, i As Long With ActiveDocument For Each oTbl In .Tables On Error Resume Next With oTbl For i = .Rows.Count To 1 Step -1 With .Rows(i) If .Cells.Count > 1 Then Set Rng = .Range If FindText(Rng, "/%") = True Then .Delete If FindText(Rng, "<[0-9]{1,2} [JFMASOND][anebrpyulgctov]{2} [0-9]{2}>") = True Then .Delete If FindText(Rng, "<[Aa][Gg][Ee]>") = True Then .Delete If FindText(Rng, "[A-Za-z0-9]") = False Then .Delete Rng.Start = .Cells(2).Range.Start If FindText(Rng, "[!0]") = False Then .Delete End If End With Next For Each oCel In .Range.Cells Set Rng = oCel.Range With Rng .End = .End - 1 If IsNumeric(.Text) Then .Text = Format(.Text, "$#,##0") End With Next With .Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = "\<[ ]@" .Replacement.Text = "<" .Execute Replace:=wdReplaceAll .Text = "[ ]@\<" .Replacement.Text = "<" .Execute Replace:=wdReplaceAll .Text = "\<" .Replacement.Text = " " .Execute Replace:=wdReplaceAll End With .Range.Font.Size = 9 .TopPadding = 5 .BottomPadding = 2 End With Next End With Application.ScreenUpdating = True End Sub Function FindText(Rng As Range, StrFnd As String) As Boolean With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = StrFnd .Replacement.Text = "" .Execute End With FindText = Rng.Find.Found End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Attached document.
Hi Paul,
I have attached the document. The requirements are same, and for clarification please look at my comments in the document. I have stated the sections which should have macro run on them. Also, there is some issue of highlighting, word does not allow me to change the highlight color using the "Text highlight color". In total there are three comments in the document. Regards Umesh Banga |
#6
|
||||
|
||||
Hi umesh,
Try: Code:
Sub FormatTables() Application.ScreenUpdating = False Dim oTbl As Table, oCel As Cell, Rng As Range, i As Long, bDel As Boolean With ActiveDocument For Each oTbl In .Tables With oTbl Set Rng = .Cell(1, 1).Range Rng.End = Rng.End - 1 If UCase(Rng.Text) <> "DATE" And UCase(Rng.Text) <> "PERIOD" Then GoTo NextTable For i = .Rows.Count To 1 Step -1 With .Rows(i) If .Cells.Count > 1 Then Set Rng = .Range bDel = False If bDel = False Then bDel = FindText(Rng, "<[Aa][Gg][Ee]>") If bDel = False Then bDel = FindText(Rng, "%") If bDel = False Then bDel = FindText(Rng, "<[0-9]{1,2} [JFMASOND][anebrpyulgctov]{2} [0-9]{2}>") If bDel = False Then bDel = Not FindText(Rng, "[A-Za-z0-9\>]") If bDel = False Then Set Rng = oTbl.Rows(i).Range Rng.Start = Rng.Cells(2).Range.Start If Len(Rng.Text) > (Rng.Cells.Count + 1) * 2 Then bDel = Not FindText(Rng, "[A-Za-z1-9\>]") End If End If End If If bDel = True Then .Delete End With Next With .Range.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = "([0-9,.]{1,})" .Replacement.Text = "$\1" .Execute Replace:=wdReplaceAll .Text = "[$]{2,}" .Replacement.Text = "$" .Execute Replace:=wdReplaceAll .Text = "\>[ ]@" .Replacement.Text = ">" .Execute Replace:=wdReplaceAll .Text = "[ ]@\>" .Replacement.Text = ">" .Execute Replace:=wdReplaceAll .Text = "\>" .Replacement.Text = " " .Execute Replace:=wdReplaceAll End With .Range.Font.Size = 9 .TopPadding = 5 .BottomPadding = 2 End With NextTable: Next End With Set Rng = Nothing Application.ScreenUpdating = True End Sub Function FindText(Rng As Range, StrFnd As String) As Boolean With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .Format = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Text = StrFnd .Replacement.Text = "" .Execute End With FindText = Rng.Find.Found End Function
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Macro - Formatting Tables
Hi Paul,
1) Thanks it works almost perfectly, however a) it deletes the top and bottom rows of some table.I have attached the result sheet for your reference. 2) Re: Highlight, I think I was not clear. I do not have any program or macro for highlight which I am trying to run. My query was, if you will see this document, there is lot of text highlighted in yellow or green color. If I try to use the standard "TEXT highlight" feature of word to change to no color, it does not work. Can you see any reason for that? Does it work on your machine? 3) I have tried to decipher the code, some parts I understand and some obviously is beyond my level. However would it possible for you to tell me that how you have made it select between the selection of tables - Which particular line of code is directing it and giving the criteria to make certain selection of tables? Regards Umesh Banga |
#8
|
|||
|
|||
Missed the attachment
here it is.
|
#9
|
||||
|
||||
Hi umesh,
Change: If bDel = True Then .Delete to: If bDel = True And i > 1 Then .Delete The code does not select any table. What it does is to loop through the table objects collection, looking for tables whose first cell has the word 'Date' or 'Period'. All of that is managed by: Code:
For Each oTbl In .Tables With oTbl Set Rng = .Cell(1, 1).Range Rng.End = Rng.End - 1 If UCase(Rng.Text) <> "DATE" And UCase(Rng.Text) <> "PERIOD" Then GoTo NextTable
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
||||
|
||||
Actually, instead of changing:
If bDel = True Then .Delete to: If bDel = True And i > 1 Then .Delete it would be more efficient to change: For i = .Rows.Count To 1 Step -1 to: For i = .Rows.Count To 2 Step -1
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Thanks Paul, I have made the recommended changes, now it puts "$" sign in front of all items in row 1too. for example if row one has Jul 12, it changes to $ Jul 12.
Any idea about how to remove shading? |
#12
|
||||
|
||||
Hi umesh,
Change: With Range.Find to: Code:
Set Rng = .Range Rng.Start = Rng.Rows(2).Range.Start With Rng.Find Code:
With .Range.Font.Shading .ForegroundPatternColor = wdColorAutomatic .BackgroundPatternColor = wdColorAutomatic End With
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Thanks Paul.
With regards to macro for shading , how can i apply that to whole document? Regards |
#14
|
||||
|
||||
As I said:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
Hi Paul,
Thanks. 1) Re: Code, works fine does not see any problem, however it still deletes the bottom border of the tables. Any idea? 2) Re shading, thanks and I gotthe point, however when i do what you have suggestd, it only removes the shading from the table rather than the "whole word" document. Regards Umesh Banga I have donethat, however it only changes |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Another Case of Automatic/Zombie Formatting of Tables | MKummerfeldt | Word Tables | 0 | 10-31-2011 10:40 AM |
Splitting multiple pages using macro | F5JASON | Excel Programming | 0 | 07-27-2011 08:22 AM |
Selecting the macro document | lars | Word VBA | 0 | 08-19-2010 06:06 AM |
Whacked formatting in tables (2007) | Roscoe | Word Tables | 6 | 06-11-2010 02:48 PM |
Keeping Tables from Splitting Between Pages | AlexPaoletti | Word Tables | 2 | 05-18-2010 01:17 AM |