I have a VBA macro in Microsoft Word 2007 that finds all tables in my document with a particular background shade color and then deletes that table. That part works fine.
But, in addition to needing to delete the table, I also need to delete the paragraph that follows it. The paragraph that ALWAYS follows is of style "Macro Text" with no text in it. It is there simply to "break up the tables" from each other so that they don't combine into one large table.
How would I do this? Following is my code for deleting the tables:
For Each aTable In ActiveDocument.Tables
If aTable.Rows(1).Cells(2).Shading.BackgroundPatternColor = wdColorGray15 Then
aTable.Delete
End If
Next aTable
At its simplest I think you need something like this. You may need to extend the range to include the entire paragraph, check the style name etc.
Dim aTable As Word.Table
Dim rng As Word.Range
For Each aTable In ActiveDocument.Tables
If aTable.Rows(1).Cells(2).Shading.BackgroundPatternColor = wdColorGray15 Then
Set rng = aTable.Range
rng.Move unit:=wdParagraph, Count:=1
aTable.Delete
rng.Delete
Set rng = Nothing
End If
Next aTable
THANKS bibadia! You saved me!
Correct answer (for finding grey text in either column of two column tables in ALL tables and then deleting those tables):
Dim aTable As Word.Table
Dim rng As Word.Range
For Each aTable In ActiveDocument.Tables
If aTable.Shading.BackgroundPatternColor = wdColorGray15 Then
Set rng = aTable.Range
rng.Move unit:=wdParagraph, Count:=1
aTable.Delete
rng.Delete
Set rng = Nothing
Else
If aTable.Rows(1).Cells(2).Shading.BackgroundPatternColor = wdColorGray15 Then
Set rng = aTable.Range
rng.Move unit:=wdParagraph, Count:=1
aTable.Delete
rng.Delete
Set rng = Nothing
End If
End If
Next aTable
Related
I'm facing a challenging request I need to solve using a VBA Macro in Word.
The document is a template that will grab some data in a DB upon generation. It contains multiple tables but I don't know how many and how many data will be in each table.
It looks like this:
Sample initial state
The requirement is to be able to detect the strings that are not followed by a table and delete them.
Said differently when a string is followed by the table, it's all good. When a string is followed by another string, it should be deleted.
The different strings are known, I'm guessing this would help.
After the macro run, my previous sample should look like this:
Sample expected result
I know it looks bit harsh but I don't even know where to start :(
I've looked at macro searching for a text but I wasn't able to find something like
IF stringA is followed by a table then do nothing if not then delete.
Any help of the community would be very much appreciated!
Thanks
Julien
This should get you started:
Sub FindAndDelete()
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "Text to find"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Next(wdParagraph).Delete
End If
Loop
End With
End Sub
Thank you so much!
I was able to make it work by slightly modifying it as the proposed code was deleting the string followed by the table:
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Delete
End If
Loop
End With
my last step is to make the macro run only for a specific part of the document. I guess I need to work on the range. I'll give a try and post the result here.
Again thank you for helping pure newbies!
So I had it working using the below code. I slightly modify the "while" loop so that it deletes the entire row rahter than just the word
Sub HeaderDelete()
'
' HeaderDelete Macro
'
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table A"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
Selection.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table B"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
End With
End Sub
The challenge is I have 50+ "this is my table X" and they may possibly change overtime...
I tried to find a solution which wouldn't be used on the ".Find" but more on "if there is a row not followed by a table then delete" but I wasn't successful so far.
On a side note I wanted to remove the table borders of all my tables and I found the below which works great!
Dim doc As Document
Dim tbl As Table
Set doc = ActiveDocument
For Each tbl In doc.Tables
With tbl.Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
Next
Again, thanks a lot for helping VBA newbies!
Below is my attempt but it's producing odd results, and the results seem to change each time i run the macro...
Can anyone see any issues in my code or can think of a better way of doing this?
Sub ConvertTablesToImages()
Dim tbl As Table
Dim currentDoc As Document
Set currentDoc = ActiveDocument
For Each tbl In currentDoc.Tables
tbl.Range.Copy
Selection.Collapse Direction:=wdCollapseStart
Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile
tbl.Delete
Next
End Sub
You had a few problems. One is mixing ranges and selections and the other is deleting members of a collection (in this case tables in the document) while trying to loop through all of them.
Take a look at this revision of your code. It should work better.
Sub ConvertTablesToImages()
Dim tbl As Table, rng As Range, i As Integer
Dim currentDoc As Document
Set currentDoc = ActiveDocument
For i = currentDoc.Tables.Count To 1 Step -1
Set tbl = currentDoc.Tables(i)
Set rng = tbl.Range
rng.Collapse Direction:=wdCollapseStart
tbl.Range.CopyAsPicture
tbl.Delete
rng.PasteSpecial DataType:=wdPasteEnhancedMetafile
rng.ShapeRange(1).ConvertToInlineShape
Next
End Sub
Just adding a variation to Rich's answer for anyone who finds that their tables are being cropped in some of the pasted images.
Adding tbl.PreferredWidth = 0 seemed to fix this
Sub ConvertTablesToImages()
Dim tbl As Table, rng As Range, i As Integer
Dim currentDoc As Document
Set currentDoc = ActiveDocument
For i = currentDoc.Tables.Count To 1 Step -1
Set tbl = currentDoc.Tables(i)
Set rng = tbl.Range
tbl.PreferredWidth = 0
rng.Collapse Direction:=wdCollapseStart
tbl.Range.CopyAsPicture
tbl.Delete
rng.PasteSpecial DataType:=wdPasteEnhancedMetafile
rng.ShapeRange(1).ConvertToInlineShape
Next
End Sub
I'm building a Word document in VBA. I add a table row by row; once it's complete, I want to insert a blank line/paragraph and then start a new table. But when I add the paragraph after the table, the insertion point appears before the paragraph marker, so the next table is added there, and becomes part of the first table.
Set HeaderTableId = WordDoc.Tables.Add(Range:=wrdSel.Range, numcolumns:=3, numrows:=1, AutoFitBehavior:=wdWord9TableBehavior)
Set RowId = HeaderTableId.Rows(1)
RowId.Cells(1) = LeftHeader
RowId.Cells(2).Range.Font.Bold = True
RowId.Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
RowId.Cells(2) = CentreHeader
RowId.Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
RowId.Cells(3) = RightHeader
' (this table only has one row)
With HeaderTableId.Range
.Collapse (WdCollapseDirection.wdCollapseEnd)
.Move Unit:=wdCharacter, Count:=3
.Select
.InsertParagraph
End With
The final .InsertParagraph correctly inserts a blank paragraph after the table, but the insertion point is then before the paragraph marker.
I've also tried inserting a page break, but it has the same problem. I can't work out how to move the insertion point to the end.
I had to "flesh out" your code in order to test - I've pasted the entire test code below.
The key to inserting a second table following the first, separated by a paragraph mark to ensure the two tables are not merged:
It's necessary to collapse the table Range twice: once before and once after inserting the new paragraph.
The code in the question uses .Move, which is unclear as to how the Range is changed. If I were to use a "move" I'd go with .MoveStart which will keep a collapsed range collapsed, but for this problem I prefer Collapse. (There's also MoveEnd, which will extend a collapsed Range to include content.)
What's also different in my version:
it uses a "working Range" that's independent of any table range - this is personal preference
it uses InsertAfter vbCr for inserting the new paragraph - again, personal preference: I always know that what's inserted is part of the Range object. Sometimes, with Insert methods the new content may not be part of the Range, but I know it is with InsertAfter and InsertBefore
The code:
Sub InsertSuccessiveTables()
Dim HeaderTableId As word.Table, nextTable As word.Table
Dim RowId As word.Row
Dim workRange As word.Range
Dim WordDoc As word.Document
Set WordDoc = ActiveDocument
Set workRange = Selection.Range
Set HeaderTableId = WordDoc.Tables.Add(Range:=workRange, numcolumns:=3, numrows:=1, AutoFitBehavior:=wdWord9TableBehavior)
Set RowId = HeaderTableId.Rows(1)
RowId.Cells(1).Range.text = "Left"
RowId.Cells(2).Range.Font.Bold = True
RowId.Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
RowId.Cells(2).Range.text = "Center"
RowId.Cells(3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
RowId.Cells(3).Range.text = "Right"
' (this table only has one row)
Set workRange = HeaderTableId.Range
With workRange
.Collapse WdCollapseDirection.wdCollapseEnd
.InsertAfter vbCr 'ANSI 13
.Collapse WdCollapseDirection.wdCollapseEnd
End With
Set nextTable = workRange.Tables.Add(workRange, 1, 4, AutoFitBehavior:=wdWord9TableBehavior)
End Sub
I have a script that looks for some text, inputted by the user. The idea is to look through a document for this text, and when it's found, select the paragraph and ask the user if they want to add this paragraph to an Index.
For some reason, I can't get the script to move past the first selected paragraph. When I run it, and click "Yes" in the UserForm (equivalent of myForm.Tag = 2), it adds to the index, but then when the .Find looks for the next instance of the text, it selects the paragraph I just had highlighted. ...it doesn't continue.
Here's the code:
Sub find_Definitions()
Dim defText As String, findText$
Dim oRng As Word.Range, rng As Word.Range
Dim myForm As frmAddDefinition
Set myForm = New frmAddDefinition
Dim addDefinition$, expandParagraph&
' expandParagraph = 1
Set oRng = ActiveDocument.Range
findText = InputBox("What text would you like to search for?")
With oRng.Find
.Text = findText
While .Execute
Set rng = oRng.Paragraphs(1).Range
rng.Select
defText = oRng.Paragraphs(1).Range
myForm.Show
Select Case myForm.Tag
Case 0 ' Expand the paragraph selection
Do While CLng(expandParagraph) < 1
expandParagraph = InputBox("How many paragraphs to extend selection?")
If expandParagraph = 0 Then Exit Do
Loop
rng.MoveEnd unit:=wdParagraph, Count:=expandParagraph
rng.Select
defText = rng
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 1 ' No, do not add to the index
' do nothing
Case 2 ' Yes, add to index
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 3 ' Cancel, exit the sub
MsgBox ("Exiting macro")
GoTo lbl_Exit
End Select
Wend
End With
lbl_Exit:
Unload myForm
Set myForm = Nothing
End Sub
(FWIW, I'm pretty new to Word VBA, but very familiar with Excel VBA). Thanks for any ideas.
Note if I click "No" (equivalent of myForm.Tag = 1), then it does move on to the next instance. Hmm.
Try adding rng.Collapse wdCollapseEnd before the "Case 1" line.
Explanation: When you use Find, it executes on the given Range or Selection.
If it's successful, that Range/Selection changes to include the "found" term. In this case, you in addition change the assignment again (expanding to include the paragraph).
When your code loops the current assignment to "Range" is used - in this case, Find looks only at the selected paragraph Range. So you need to reset the Range in order to have Find continue.
To be absolutely accurate, after Collapse you could also add:
rng.End = ActiveDocument.Content.End
Note: it's more correct to use ActiveDocument.Content than ActiveDocument.Range. ActiveDocument.Range is actually a method for creating a new Range by specifying the Start and End points, while ActiveDocument.Content returns the entire main story (body) of the document as a Range object. VBA doesn't care, it defaults the method to return the main story. Other programming languages (.NET, especially C#) don't work as intuitively with Word's object model, however. So it's a good habit to use what "always" works :-)
In my code below, when the word isn't there, all the table contente is deleted. How to fix it? Text is in Cell(1,1) for multiple tables.
Sub DeleteText()
StartWord = "Orientation:"
For Each oTbl In ActiveDocument.Tables
Set oRng = oTbl.Range
With oRng
.Find.Execute Findtext:=StartWord & "*", MatchWildcards:=True
.MoveStart wdCharacter, 0
.MoveEndUntil vbCr
.Delete
End With
Next
End Sub
First of all you need to add if statement which will check if your text is found. You will find that in the code below. However, I also improved the way you delete the whole content of cell where your text is found. My solution is better in situation when you have more lines/paragraphs/sentences in the cell.
Sub DeleteText_Improved()
Dim StartWord As String
Dim oTbl As Table
Dim oRng As Range
StartWord = "Mauris"
For Each oTbl In ActiveDocument.Tables
Set oRng = oTbl.Range
With oRng
.Find.Execute Findtext:=StartWord & "*", MatchWildcards:=True
If .Find.Found Then
'how to select whole cell range
oTbl.Cell(.Information(wdEndOfRangeRowNumber), _
.Information(wdEndOfRangeColumnNumber)).Range.Delete
End If
End With
Next
End Sub
Final remark- your code is working only for the first occurrence of the word you search for. It will not remove other cells where the word appears.