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
Related
I have a word document that is being generated from my program and currently have a macro that replaces <BR/> tags with a newline. This signifies the start of a new section in the table so I also wanted to add a border to the top of that row where the <BR/> tag occurs. My current code is:
With ActiveDocument.Content.Find
.Text = "<BR/>"
.Forward = True
While .Execute
.Parent.Text = Chr(10)
.Parent.Collapse wdCollapseEnd
Wend
End With
How could I get the entire row in the table where <BR/> occurs and then add a border to it?
My attempt so far was to add at end of the while loop after Collapse:
With .Parent.Row.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
But that does not do anything (also no error). I do not think I am grabbing the row correctly but I can not find any other way of doing it. Thanks.
EDIT:
I am now thinking maybe I should do a separate check before the newline part. So adding a for loop to loop through all table rows, check if <BR/> exists and if it does add a border to the top of the row.
I am not used to vba in word, usually use excel so think I might be mixing the two. Here is what I have got so far:
Dim oTbl As Table
Set oTbl = ActiveDocument.Tables(1)
For Each oRow In oTbl.Rows
If InStr(1, oRow.Cell(1, 1), "<BR/>", vbBinaryCompare) > 0 Then
oRow.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
Next
Ok I got it working using the for loop way. My final code was:
Dim oTbl As Table
Dim oRow As Row
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Rows
If InStr(1, oRow.Cells(1).Range.Text, "<BR/>", vbBinaryCompare) > 0 Then
oRow.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
End If
Next
Next
So this loops through all tables in the document and then all the rows in each table adding a border line above each row that contains the <BR/> tag in its first cell (which signifies a new section). I do all this before the next part of the code which replaces the <BR/> tag with the new line character.
Hopefully this helps someone in the future.
I'm building an index via a macro, and after a little bit, the page numbers start to get wonky. At first, they are correct, but as we go deeper in the document, they start getting offset.
I have a hunch it's because the code I'm using uses a range (.Index.MarkEntry Range:=theRange ...), and the page of the end of the range is where the page number comes from.
How can I make sure that the page number the index uses, is the page that has the first character in the range (does that make sense? Whatever page the entry starts on, is the page I want to use).
Here's my (truncated for relevance) code:
Sub Find_Definitions()
Dim myDoc As Word.Document
Dim oRng As Word.Range, rng As Word.Range, rngXE As Word.Range, tempHold As Word.Range
Dim addDefinition$, findText$, editedDefinition$
Dim meanTypes() As Variant
Dim rngEdited
Dim y&
Dim bFound As Boolean
meanTypes = Array(Chr(150) & " means", Chr(151) & " means", "- means", Chr(150) & " meaning", Chr(151) & " meaning", "- meaning")
Set myDoc = ActiveDocument
bFound = True
Call Clear_Index
For y = LBound(meanTypes) To UBound(meanTypes)
'Loop through the document
Set oRng = myDoc.Content
Set rngXE = oRng.Duplicate
With oRng.Find
.ClearFormatting
.ClearAllFuzzyOptions
'.Text = findText
.Text = meanTypes(y)
.MatchCase = False
.Wrap = wdFindStop
End With 'orng.find
Do While bFound
bFound = oRng.Find.Execute
If bFound Then
Set rngXE = oRng.Paragraphs(1).Range.Duplicate
rngXE.Select
' Here's where I could check the text, and see if it starts with Roman numerals.
editedDefinition = Check_For_Roman_Numerals(rngXE, findText)
If editedDefinition <> "" Then 'If editedDefinition is empty, that means there's no definition to add to the index
Set rngEdited = rngXE.Duplicate
With rngEdited
.moveStart unit:=wdCharacter, Count:=x
.Select
‘ This next line is my idea that the range’s page number is being used, so I just wanted to print it to see.
Debug.Print rngEdited.Information(wdActiveEndPageNumber)
End With 'rngEdited
myDoc.Indexes.MarkEntry Range:=rngEdited, entry:=editedDefinition, entryautotext:=editedDefinition
End If ''editedDefinition <> ""
oRng.Collapse wdCollapseEnd
oRng.Start = oRng.Paragraphs(1).Range.End
oRng.End = myDoc.Content.End
rngEdited.Collapse wdCollapseEnd
rngEdited.End = myDoc.Content.End
' Set rngXE = Nothing
End If 'bFound
Loop
bFound = True
Next y
TheEnd:
Set rng = Nothing
myDoc.Indexes(1).Update
MsgBox ("Added all definitions.")
End Sub
I'm thinking what I'll need to do is to "tighten up" the editedRange, so it ends on the same page? But if a definition spans a page break, I want to use the smaller of the page numbers that it appears on (the first one).
Thanks for any ideas/tips/thoughts.
Generally, when the page numbers in an Index don't match with what you expect it's because the document is displaying content that won't be in the printed result. This affects the pagination on-screen, "pushing" content "down" in the document. Most often, the reason is field codes, which can be suppressed by pressing Alt+F9 until the field results display.
This approach does not work for XE (index markers) and some other field types, as well as hidden text, however. They display whenever the display of "Hidden" text is allowed. Depending on the settings in File/Options/Display/"Always show these formatting marks on the screen" clicking the "backwards P" button in the Ribbon's Home tab may or may not turn them off. If it does not, then you have to go into options to togge the display, or create a macro to do this and run it as required.
The other possible reason is that the programmatically generated XE field was inserted at the end of a long range of text that broke to another page, instead of being on the page where the text starts. In order to ensure the field is the start, rather than the end of a Range, collapse the Range to its starting point:
rngEdited.Collapse wdCollapseStart
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 :-)
A vba script that seems simple but don't work exactly as I want .
My script inserts images ( PNG files) in the current document with a caption after each picture that is the name of the file.
So to insert images I use:
Selection.InlineShapes.AddPicture FileName: = sFile
Selection.TypeParagraph
And to insert text after I use:
Set Opar = ActiveDocument.Paragraphs.Add
oPar.Range.Text = sFile
oPar.Range.Style = " Normal"
The problem is that images are all found in the beginning of the document , arranged in reverse order (the last image inserted appears first in the document) and legends are all found at the end of the document.
What's happening ?
#Boro: It's more efficient to work directly with the object model than trying to coerce Selection (imitating the user actions). There's no single way to achieve what you describe, so I'm going to demonstrate my preference:
Dim ils as Word.InlineShape
Dim rng as Word.Range
'Starting with current sel, but this could also be a Range...
Set ils = Selection.InlineShapes.AddPicture(FileName: = sFile)
Set rng = ils.Range
'Move the focus AFTER the picture
rng.Collapse wdCollapseEnd
'new para, text, followed by new para
rng.Text = vbCr & sFile & vbCr
rng.Style = wdStyleNormal
'focus in last para inserted by code
rng.Collapse wdCollapseEnd
'Do other things with the Range...
'Leave cursor there for user to work
rng.Select
The key in my approach is collapsing the Range, either to the start or end point. Think of it like pressing the left or right arrow key to reduce the selection to a blinking cursor. Except you can have any number of Ranges (but only one Selection) and things won't jump around on the screen.
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