I've to create a report in Word document without a template. This report consists of records from MS Access - and there will be some text and then a table, iterative based on # of records (I'll be creating tables dynamically using VBA based on the # of records).
I can start inserting text in the word document using a bookmark as starting point and then able to add a table and fill in cells. The question once done filling in the table how can I place the cursor on the next line after table to start inserting text.
following is my code anyone with some hints or example would appreciate - Thanks!
Set wordObj = CreateObject("Word.Application")
Set wordDoc = wordObj.Documents.Open(fileName:=wrdTMPLT, Visible:=True)
wordDoc.Bookmarks("rptdate").Range.Text = Format(DATE, "dd-mmm-yyyy")
Set wordrange = wordDoc.GoTo(what:=wdGoToBookmark, Name:="startpoint") 'set cursor to start point
wordrange.Text = Me.Text3_CHK
Set wordrange = wordDoc.GoTo(what:=wdGoToBookmark, Name:="tblpoint") 'set cursor to location to insert table
Set tbl = wordDoc.Tables.Add(Range:=wordrange, numrows:=4, numcolumns:=2)
tbl.CELL(1, 1).Merge MergeTo:=tbl.CELL(1, 2)
tbl.CELL(3, 1).Merge MergeTo:=tbl.CELL(3, 2)
tbl.CELL(4, 1).Merge MergeTo:=tbl.CELL(4, 2)
tbl.CELL(1, 1).Range.InsertAfter "Title: "
tbl.CELL(2, 1).Range.InsertAfter "Coordinator: "
tbl.CELL(2, 2).Range.InsertAfter "Engineer: "
tbl.CELL(3, 1).Range.InsertAfter "Vendor 1: "
tbl.CELL(3, 2).Range.InsertAfter "Vendor 2: "
tbl.CELL(4, 1).Range.InsertAfter "Contractor: "
tbl.Borders.Enable = False
'Following text to enter after the table above
wordrange.Text = "HellO"
'continue with next table ... n text/table cycle based # of records
To get to the point (paragraph) following a table, assign the table's Range to a Range object then collapse it to its end-point:
Dim rng as Word.Range
'Do things here until table is finished
Set rng = tbl.Range
rng.Collapse wdCollapseEnd
'Now the Range is after the table, so do things with it, for example:
rng.Text = "more text"
Related
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'm trying to bookmark the contents of a Word table cell (the contents will be numbers) so that I can cross-reference the bookmark in text elsewhere in the document - the goal being that if the numbers in the cells change, by running an "update all fields" macro (which I already have) I can update all of the in-text references to these numbers without having to manually scour the entire document. I've been through the interwebs and found something similar (my adapted version is shown below), however the issue with this method is that when I try to cross-reference the bookmark, it keeps the cell formatting - so there will be text and then suddenly a random cell and then more text. The good thing about this method is that the number does actually update as it's supposed to, I just can't get rid of the cell formatting.
Sub BookmarkCurrentCell()
If Selection.Information(wdWithInTable) Then
selectedTable = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
selectedColumn = Selection.Information(wdStartOfRangeColumnNumber)
selectedRow = Selection.Information(wdStartOfRangeRowNumber)
End If
ActiveDocument.Bookmarks.Add Name:="Bookmark_" & selectedTable & "_" & selectedRow & "_" & selectedColumn, Range:=ActiveDocument.Tables(selectedTable).Cell(selectedRow, selectedColumn).Range
End Sub
Thanks in advance!
Try this:
Sub BookmarkCurrentCell()
Dim rng As Range
If Selection.Information(wdWithInTable) Then
selectedTable = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
selectedColumn = Selection.Information(wdStartOfRangeColumnNumber)
selectedRow = Selection.Information(wdStartOfRangeRowNumber)
End If
Set rng = ActiveDocument.Tables(selectedTable).Cell(selectedRow, selectedColumn).Range
rng.End = rng.End - 1
ActiveDocument.Bookmarks.Add Name:="Bookmark_" & selectedTable & "_" & selectedRow & "_" & selectedColumn, Range:=rng
End Sub
I think the problem is that you are applying the bookmark to the entire cell, the modified code sets a range = to the cell range, then moves the end of the range back 1 character so that it only includes the cell contents (and not the actual cell).
I am currently working on a project and am looking for some assistance. To give you guys a layout of what is happening, I will run through the scenario step by step.
1) Currently I have a string array called “AnimalNamesToRemove” (For this example the array with contain the following words), that contains words that are used as bookmarks in a word document that I am looking to remove off a word table referenced below:
AnimalNamesToRemove
AnimalCat, AnimalDog, AnimalBird
2) In addition to the array, a table in a word document exists that has the name of the animal in column one, as well as some information about the animal (the only information that is of importance is the name of the animal):
Word Table
3) For this scenario, I have an excel table that I am looking to use to reference the words in the array and the word table names, as there are already bookmarks in the word document being used that hold the names existing in the array. To bring these together, a two column excel spreadsheet exists that has the name of the bookmark and the actual animal name (Column two is referenced using the range named “myRangeRef”):
Spreadsheet
4) What I am looking to do is that for every value in the array stated above, if that value (ex. “AnimalDog”) is found in the spreadsheet table (i.e. column two “Bookmark Reference”) then offset to the respective cell beside it in the first column (i.e. “Dog”) and create a new comma delimited string with those values, the same as “AnimalNamesToRemove” (i.e. Cat, Dog, Bird) and then turn it into a string array named “AnimalsToDelete”. Once the array is created, and all the values have been selected in the first column and made into an array based on the reference in column two, I want to go row by row in the word table and for every value existing in the new array “AnimalsToDelete”, if that value (i.e. Cat, Dog, and Bird) exists in the word table (found in column one), I want the code to delete the entire row that the name is found in (see result shown below)
Example Result
Dim wdTable As Object
Dim myRangeRef As Range
Dim AnimalNamesToRemove As Variant
Dim AnimalsToDelete As Variant
Dim wdDoc As Object
Set myRangeRef = ThisWorkbook.Sheets("Bookmark References").Range("B1:B6")
Set wdTable = wdDoc.Tables(1)
For i = LBound(AnimalNamesToRemove) To UBound(AnimalNamesToRemove)
For Each cell In myRangeRef
If InStr(1, cell.Value, AnimalNamesToRemove(i), vbTextCompare) Then
aCell = cell.Offset(, -1).Value
stTemp = stTemp & "," & aCell
End If
Next cell
Next i
stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
AnimalsToDelete = Split(stTemp, ",")
For i = LBound(AnimalsToDelete) To UBound(AnimalsToDelete)
For j = wdTable.Rows.Count To 2 Step -1
If wdTable.cell(j, 1).Range.Text = AnimalsToDelete(i) Then wdTable.Rows(j).Delete
Next j
Next i
End If
If you have any solutions and/or suggestions please comment them down below.
NOTE: The first section of code works for creating the string array (i.e. from "set wdTable =" to "next i"), its the removal of information from the word table that I'm having the issues with.
Best,
Jack Henderson
Alright, based on your code I added a Reference to the Microsoft Word 16.0 Object Library in my Excel VBE (Tools - References, check the box) so we have the Word stuff available.
Next I wrote the following procedure:
Sub Test()
Dim BookMarksToDelete() As String
Dim ReturnsToDelete() As String
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wdTable As Word.Table
Dim myRangeRef As Range
Dim cel As Range
Dim aCell As String
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Temp\Col1.docx")
Set wdTable = wDoc.Tables(1)
ReDim BookMarksToDelete(0 To 1)
BookMarksToDelete(0) = "BlahOne"
BookMarksToDelete(1) = "BlahThree"
Set myRangeRef = Worksheets("Sheet1").Range("B1:B5")
For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
For Each cel In myRangeRef
If InStr(1, cel.Value, BookMarksToDelete(i), vbTextCompare) Then
aCell = cel.Offset(0, -1).Value
stTemp = stTemp & "," & aCell
End If
Next cel
Next i
stTemp = Mid(stTemp, 2)
If Not Len(Trim(stTemp)) = 0 Then
ReturnsToDelete = Split(stTemp, ",")
For i = LBound(ReturnsToDelete) To UBound(ReturnsToDelete)
For j = wdTable.Rows.Count To 2 Step -1
If Left(wdTable.cell(j, 1).Range.Text, Len(wdTable.cell(j, 1).Range.Text) - 2) = ReturnsToDelete(i) Then
wdTable.Rows(j).Delete
End If
Next j
Next i
End If
wDoc.Save
wDoc.Close
wApp.Quit
Set wdTable = Nothing
Set wDoc = Nothing
Set wApp = Nothing
Set myRangeRef = Nothing
End Sub
As you can see, I basically stuck to your exact same structure and it works perfectly.
Your main issue (the rows in the word doc not being deleted or found) is because the text in a Cell in a table in word actually contains 2 extra characters in the very end. One is a "fake new line" and the other one shows up when you hit this paragraph button on the word GUI - It's an "end of cell" marker.
See for example this discussion
EDIT I based myself on the "BlahOne" and "NameOne" example, but yeah, you can edit it for animals, of course...
I'm new to VBA and would greatly appreciate some help on a problem.
I have long Word documents where I need to apply standard comments to the same set of keywords, but only in selected sections of the document. The following macro worked to find a keyword and apply a comment (from question here https://superuser.com/questions/547710/macro-to-insert-comment-bubbles-in-microsoft-word):
Sub label_items()
'
' label_items Macro
'
'
Do While Selection.Find.Execute("keyword1") = True
ActiveDocument.Comments.Add range:=Selection.range, Text:="comment for keyword 1"
Loop
End Sub
The two modifications are:
1) only apply the comments to user selected text, not the whole document. I tried a "With Selection.Range.Find" approach but I don't think comments can be added this way (??)
2) repeat this for 20+ keywords in the selected text. The keywords aren't totally standard and have names like P_1HAI10, P_1HAI20, P_2HAI60, P_HFS10, etc.
EDIT: I have tried to combine code from similar questions ( Word VBA: finding a set of words and inserting predefined comments and Word macro, storing the current selection (VBA)) but my current attempt (below) only runs for the first keyword and comment and runs over the entire document, not just the text I have highlighted/selected.
Sub label_items()
'
' label_items Macro
'
Dim selbkup As range
Set selbkup = ActiveDocument.range(Selection.range.Start, Selection.range.End)
Set range = selbkup
Do While range.Find.Execute("keyword 1") = True
ActiveDocument.Comments.Add range, "comment for keyword 1"
Loop
Set range = selbkup
Do While range.Find.Execute("keyword 2") = True
ActiveDocument.Comments.Add range, "comment for keyword 2"
Loop
'I would repeat this process for all of my keywords
End Sub
I've combed through previous questions and the Office Dev Center and am stuck. Any help/guidance is greatly appreciated!
It's a matter of adding a loop and a means of Finding the next keyword you're looking for. There are a few suggestions in the code example below, so please adjust it as necessary to fit your requirements.
Option Explicit
Sub label_items()
Dim myDoc As Document
Dim targetRange As Range
Set myDoc = ActiveDocument
Set targetRange = Selection.Range
'--- drop a bookmark to return the cursor to it's original location
Const RETURN_BM = "OrigCursorLoc"
myDoc.Bookmarks.Add Name:=RETURN_BM, Range:=Selection.Range
'--- if nothing is selected, then search the whole document
If Selection.Start = Selection.End Then
Selection.Start = 0
targetRange.Start = 0
targetRange.End = myDoc.Range.End
End If
'--- build list of keywords to search
Dim keywords() As String
keywords = Split("SMS,HTTP,SMTP", ",", , vbTextCompare)
'--- search for all keywords within the user selected range
Dim i As Long
For i = 0 To UBound(keywords)
'--- set the cursor back to the beginning of the
' originally selected range
Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
Do
With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Text = keywords(i)
.Execute
If .Found Then
If (Selection.Start < targetRange.End) Then
Selection.Comments.Add Selection.Range, _
Text:="Found the " & keywords(i) & " keyword"
Else
Exit Do
End If
Else
Exit Do
End If
End With
Loop
Next i
'--- set the cursor back to the beginning of the
' originally selected range
Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
End Sub
I have a Word VBA script that adds some headings and a table to the current selection. I'm now trying to get it to pull information from the table below and put it under the correct heading. The end goal is to take the information out of table format for better navigation, because Word's outline doesn't recognize headings inside tables.
I've only gotten as far as putting table content into string variables before I get run-time error 5941: The requested member of the collection does not exist. The debugger goes to this line:
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
The table has far more than two rows and four columns. To make sure the member of the collection existed, I used another script to give me the row and column for the current selection:
Sub CellRowColumn()
'For the current selection, shows a message box with the cell row and column.
With Selection.Cells(1)
MsgBox ("Column = " & .ColumnIndex & vbCr & "Row = " & .RowIndex)
End With
End Sub
I ran this one in the cell I want to copy from, and it does show Row 2 & Column 4.
This is the code I'm using:
Sub ElementHeadings()
'With the current selection, adds the headings for each element in the
'Elements and Attribute List (Description, Parent(s), and Child(ren)) and
'a table for attributes, with 3 columns, headed "Attribute
'Name", "Attribute Required?" and "Attribute Content")
Dim rngSelection As Range
Dim rngTable As Range
Dim rngHeading As Range
Dim rngSource As Range
Dim strCaption As String
Dim lngCaptionLength As Long
Dim strDescr As String
Dim strParents As String
Dim strChildren As String
Dim strVol As String
Dim strUsedIn As String
Set rngSelection = Selection.Range
'msgBox (rngSelection.Text)
With rngSelection
.InsertAfter ("Description")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Parent(s)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Child(ren)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertParagraphAfter
.InsertParagraphAfter
Set rngTable = .Paragraphs(5).Range
.InsertAfter ("Volume & Chapter")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Used In")
.Expand unit:=wdParagraph
.Style = "Heading 4"
'MsgBox (rngSelection.Text)
End With
ActiveDocument.Tables.Add Range:=rngTable, NumRows:=3, NumColumns:=3
With rngTable
.Tables(1).Cell(1, 1).Range.Text = "Attribute Name"
.Tables(1).Cell(1, 2).Range.Text = "Attribute Required?"
.Tables(1).Cell(1, 3).Range.Text = "Attribute Content"
.Select
GenericMacros.TableFormat
.Move unit:=wdParagraph, Count:=-1
.Select
End With
rngSelection.Select
Set rngHeading = Selection.GoTo(what:=wdGoToHeading, Which:=wdGoToPrevious)
rngHeading.Expand unit:=wdParagraph
'MsgBox (rngHeading.Text)
rngTable.Select
strCaption = rngHeading.Text
lngCaptionLength = Len(strCaption)
strCaption = Left(strCaption, lngCaptionLength - 1)
Selection.InsertCaption Label:=wdCaptionTable, Title:=". <" _
& strCaption & "> Attribute Table"
rngSelection.Select
Set rngSource = Selection.GoTo(what:=wdGoToTable, Which:=wdGoToNext)
rngSource.Expand unit:=wdTable
strDescr = rngSource.Tables(1).Cell(Row:=2, Column:=2).Range.Text
strParents = rngSource.Tables(1).Cell(Row:=2, Column:=3).Range.Text
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
strVol = rngSource.Tables(1).Cell(Row:=2, Column:=8).Range.Text
strUsedIn = rngSource.Tables(1).Cell(Row:=2, Column:=9).Range.Text
MsgBox ("strDescr = " & strDescr & vbCr & "strParents = " & strParents & _
vbCr & "strChildren =" & strChildren & vbCr & "str3001Vol = " _
& str3001Vol & "strUsedIn = " & strUsedIn)
End Sub
(This may end up being a SuperUser question rather than a Stack Overflow question, if the problem is the document rather than my code. Previously, I was having trouble copying and pasting from the table (copying text but not getting the option to paste it above), but that's no longer happening. So if there's not an apparent issue with the code, maybe it's document corruption or some other Word weirdness.)
Update: My source range contained the table I had just created, rather than the one I wanted to pull from, so I fixed the Selection.Goto that was creating rngSource.
Good that you were able to track down where your code was failing. Working with the Selection object tends to be unreliable as it may not be where you're assuming (or where it was) when you wrote the code.
It's much better to work with Word's objects as whenever possible. For example, when you create a table, Dim a variable, then assign to it when you create the table. That gives you a "handle" on the table, no matter what kind of editing takes place before it, later:
Dim tbl as Word.Table
Set tbl = ActiveDocument.Tables.Add(Range:=rngTable, NumRows:=3, NumColumns:=3).
tbl.Cell(1,1).Range.Text = "Attribute Name"
'and so on...
To pick up an existing table you need to be able to identify it. If you're certain of the position, then:
Set tbl = ActiveDocument.Tables([index value])
If this is a "template" kind of document that you set up and re-use you can bookmark the table (select the table and insert a bookmark, or click in the first cell and insert a bookmark), then:
Set tbl = ActiveDocument.Bookmarks("BookmarkName").Range.Tables(1)
In a similar vein, you can replace this:
rngHeading.Expand unit:=wdParagraph
with the following if you want to work with the paragraph, explicitly:
Dim para as Word.Paragraph
Set para = rngHeading.Paragraphs(1)
It may also help you to know you can "collapse" a Range (similar to pressing the Arrow key with a selection) to its start or end point. This is useful if you want to add something, format it, then add something else that should have different formatting... (as an alternative to using InsertAfter consecutively then going back and formatting things differently).
I got something like OP, and after running below code:
Dim tbl As Word.Table: Set tbl = doc.Tables(2)
MsgBox tbl.Cell(1, 1).Range.Text
Which works on the idea that each table should have at least one cell in it,
did notice that I was accessing the wrong table too ;-)
So, you may use that first to get sure.