I am trying to insert tables marked with a Name via a bookmark so I can later recognize them again.
Below I have added my source code in question. At pos3 I created a table with 2 rows and add a bookmark for its range. But when repeating the Sub I always end up in the case of pos1 .. my bookmark is not found in the table selection. (trying to reach pos2)
The bookmark itself is added, but maybe not to the table. I suspect the error to be there.
I can see the bookmark in the bookmark-list of Word. But if I do a manual "go to" the cursor seems to end up off screen somewhere, so I suspect its not added correctly to the table range.
Private Sub PrepareFooter()
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim oRng As Range
Dim tbl As Table
Dim cell As cell
Dim foundFooterTable As Boolean
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
With oFooter.Range
For Each tbl In .Tables
tbl.Select
If Selection.Bookmarks.Count <> 1 Then
tbl.Delete ' <-- pos1
ElseIf Selection.Bookmarks(1).Name <> "FooterTable" Then
tbl.Delete
Else
foundFooterTable = True ' <-- pos2
FormatFooterTable tbl
End If
Next
End With
oFooter.Range.Select
Selection.Collapse wdCollapseStart
If Not foundFooterTable Then
Set tbl = ActiveDocument.Tables.Add(Selection.Range, 2, 1)
tbl.Select
ActiveDocument.Bookmarks.Add Range:=Selection.Range
, Name:="FooterTable" ' <- pos3
FormatFooterTable tbl
End If
Next oFooter
Next oSection
End Sub
thanks for any ideas about what I might do wrong!
Try to work without Selection as much as you can. Whenever possible, use a Range object. That will make your code clearer and more reliable.
In order to put a bookmark "around" a table (pos 3):
ActiveDocument.Bookmarks.Add Range:=tbl.Range, Name:="FooterTable"
When this works, you should be able to get the table using:
Dim sFooterTable as String
sFooterTable = "FooterTable"
If ActiveDocument.Bookmarks.Exists(sFooterTable) Then
Set tbl = ActiveDocument.Bookmarks(sFooterTable).Range.Tables(1)
found my mistake:
I was applying the same bookmark name on all tables that were found .. this way deleting the previous bookmarks as they need a unique name.
adding a unique identifier in the end (I used an integer now) made the code work.
Related
I have messed cross-references to pictures in my word document. The label shows only part of the figure name:
Figure 5-
I have found out that bookmark responsible for that has narrowed range than the full figure name:
[Figure 5-] 62: Caption text
I would like to extend the bookmark label up to ":" using VBA, but I have no idea how to go further with the code.
Bookmark.Start and Bookmark.End refer to the whole picture text so how to refer only to label? my code is as follow:
Sub extend_bookmarks()
Dim bmk As Bookmark
Dim msg As String
Dim pos As Integer
For Each bmk In ActiveDocument.Range.Bookmarks
If (InStr(1, bmk.Range.Text, "Figure") And IsNumeric(Mid(bmk.Range.Text, 8, 1))) Then
pos = InStr(1, bmk.Range.Text, ":")
If ((pos < 12) And (pos > 0)) Then
Debug.Print bmk.Name
Debug.Print bmk.Range.Text
Debug.Print bmk.End - bmk.Start; pos
End If
End If
Next bmk
End Sub
You could just reapply the bookmark using the paragraph it sits in as the range.
Sub extend_bookmarks()
Dim bmk As Variant
For Each bmk In ActiveDocument.Range.Bookmarks
ActiveDocument.Bookmarks.Add Range:=bmk.range.Paragraphs(1).range, Name := bmk.Name
Next
End Sub
Update, When I tested the code above I only stepped through the loop twice and so missed the obvious, that you cannot use 'for each' when you are changing the content of a collection.
The code below correctly extends the bookmarks as intended and does not crash word.
Sub extend_bookmarks()
Dim myCount As Long
myCount = ActiveDocument.Bookmarks.Count
Dim myIndex As Long
With ActiveDocument.Bookmarks
For myIndex = myCount To 1 Step -1
.Add Range:=.Item(myIndex).Range.Paragraphs(1).Range, Name:=.Item(myIndex).Name
Next
End With
End Sub
I have a large number of reports which have multiple tables that need to have their heading color adjusted. I'm running into an issue with tables who have vertically merged cells in the header though. Here's the code:
Sub Recolor_Table()
Dim Doc_Table As Table
For Each Doc_Table In ActiveDocument.Tables
If Doc_Table.Style Like "*Non-Results Table*" Then
'Since this will match "*Results Table*" as well, check it first
Doc_Table.Rows(1).Shading.BackgroundPatternColor = 12566463 'Grey
ElseIf Doc_Table.Style Like "*Results Table*" Then
Doc_Table.Rows(1).Shading.BackgroundPatternColor = 8406272 'Blue
End If
Next Doc_Table
End Sub
This fails with the following error message:
Run-time error '5991':
Cannot access individual rows in this collection because the table has vertically merged cells
I tried adjusting to a loop through each cell in the table, but found that tables in word do not have a .cells property, so a For each cell in table.cells style loop wouldn't work.
Is there any other way to do this? Possibly editing the table style directly?
The Table object doesn't have a Cells property, but the Table.Range object does, so:
For Each cel in Table.Range.Cells
should work:
Sub LoopCellsInTableWithMergedCells()
Dim tbl As word.Table
Dim cel As word.Cell
Set tbl = ActiveDocument.Tables(1)
For Each cel In tbl.Range.Cells
Debug.Print cel.rowIndex, cel.ColumnIndex
Next
End Sub
I dimmed the variable:
Dim mainTableRange As Range
Then gave it a value:
Set mainTableRange = Range("tLedgerData") ' tLedgerData is an Excel table.
Now I'm trying to get the name of the table (which is "tLedgerData") from the variable to reference columns in that table even if the table name changes.
I tried
mainTableRange.Name
and
mainTableRange.Name.Name
(See how do you get a range to return its name.) Both threw run-time error '1004': Application defined or object-defined error.
mainTableRange.Select selected all table data excluding the header and total rows.
I think you're having an X-Y problem here: solving problem X when the solution is for problem Y.
[...] to reference columns in that table even if the table name changes
Have the table / ListObject alone on its own dedicated worksheet, and give the sheet a CodeName. That way you can do this:
Dim tbl As ListObject
Set tbl = LedgerDataSheet.ListObjects(1)
And now you have the almighty power of the ListObject API to do whatever it is that you want to do. For example, retrieve the column names:
Dim i As Long
For i = 1 To tbl.ListColumns.Count
Debug.Print tbl.ListColumns(i).Name
Next
In other words, you don't need to care for the name of the table. What you want is to work with its ListObject. And since you never need to refer to it by name, the table's name is utterly irrelevant and the user can change it on a whim, your code won't even notice.
I believe an Excel table and named-range are two different things which is why the .name.name doesn't work. A table is a ListObject and once you set a range equal to a table you should be able to continue to call that range without an error.
Curious, what is the reason why your table might change unexpectedly?
I wrote out some lines of code to show a couple things. You can create tables and reuse the range variables after the table name changes. You can also set AlternativeText for the table with some identifying string and use that to locate a particular table if you suspect the table name may change.
Option Explicit
Public TestTable As Range
Sub CreateTable()
ActiveSheet.ListObjects.Add(xlSrcRange, [$A$1:$C$4], , xlYes).name = "Table1"
ActiveSheet.ListObjects("Table1").AlternativeText = "Table1"
End Sub
Sub SetTableRange()
Set TestTable = Range("Table1")
End Sub
Sub SelectTable()
TestTable.Select
End Sub
Sub RenameTable()
ActiveSheet.ListObjects("Table1").name = "Table2"
[A1].Select
End Sub
Sub SelectRenamedTable()
TestTable.Select
End Sub
Sub ClearSelection()
[A1].Select
End Sub
Sub FindTable1()
Dim obje As ListObject
For Each obje In ActiveSheet.ListObjects
If obje.AlternativeText = "Table1" Then
MsgBox "Found " & obje.AlternativeText & ". Its current name is: " & obje.name
End If
Next obje
End Sub
Sub ConvertTablesToRanges()
' I found this snippet in a forum post on mrexcel.com by pgc01 and modified
Dim rList As Range
On Error Resume Next
With ActiveSheet.ListObjects("Table1")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
With ActiveSheet.ListObjects("Table2")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
On Error GoTo 0
With rList
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = xlColorIndexAutomatic
.Borders.LineStyle = xlLineStyleNone
End With
End Sub
OP Update:
Thanks for the code KazJaw, it prompted me to change the approach I am trying to tackle the problem with. This is my current code:
Sub Method3()
Dim intFieldCount As Integer
Dim i As Integer
Dim vSt1 As String
intFieldCount = ActiveDocument.Fields.Count
For i = 1 To intFieldCount
ActiveDocument.Fields(i).Select 'selects the first field in the doc
Selection.Expand
vSt1 = Selection.Fields(1).Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
ActiveDocument.Bookmarks(vSt1).Select 'Selects the current crossreference in the ref list
Next i
End Sub
Ok the so the Code currently finds the first field in the document, reads its field code and then jumps to the location in the document to mimic a CTRL+Click.
However, It does this for all types of fields Bookmarks, endnotes, figures, tables etc. I only want to find Reference fields. I thought I could deduce this from the field code but it turns out figures and bookmarks use the same field code layout ie.
A Reference/Boookmark has a field code {REF_REF4123123214\h}
A Figure cross ref has the field code {REF_REF407133655\h}
Is there an effective way to get VBA to distinguish between the two? I was thinking as reference fields in the document are written as (Reference 1) I could find the field and then string compare the word on the left to see if it says "Reference".
I was thinking of using the MoveLeft Method to do this
Selection.MoveLeft
But I can't work out how to move left 1 word from the current selection and select that word instead to do the strcomp
Or perhaps I can check the field type? with...
If Selection.Type = wdFieldRef Then
Do Something
End If
But I am not sure which "Type" i should be looking for.
Any advice is appreciated
All REF fields "reference" bookmarks. Word sets bookmarks on all objects that get a reference for a REF field: figures, headings, etc. There's no way to distinguish from the content of the field what's at the other end. You need to "inspect" that target, which you can do without actually selecting it. For example, you could check whether the first six letters are "Figure".
The code you have is inefficient - there's no need to use the Selection object to get the field code. The following is more efficient:
Sub Method3()
Dim fld As Word.Field
Dim rng as Word.Range
Dim vSt1 As String
ForEach fld in ActiveDocument.Fields
vSt1 = fld.Code
'MsgBox vSt1
vSt1 = Split(vSt1, " ")(2) 'Find out what the (2) does
MsgBox vSt1
Set rng = ActiveDocument.Bookmarks(vSt1).Range
If Left(rng.Text, 6) <> "Figure" Then
rng.Select
End If
Next
End Sub
I have in my word document many tables, each is linked to bookmark.
Then I have function which scan document for each tracked change (revisions).
How can I find out where my tracked change is? in which table?
Here is some of my code:
Dim ThisWord As Document, TabHead As Table
Set ThisWord = ActiveDocument
Set TabHead = ThisWord.Bookmarks("Head").Range.Tables(1) '"Head" is bookmark for my first table
For Each oRevision In ThisWord.Revisions 'Run through each revision - tracked change
Select Case oRevision.Type
Case wdRevisionInsert
strText = oRevision.Range.Text
If oRevision.Range.Information(wdWithInTable) = True Then 'Check if tracked change is within table
Select Case oRevision.Range.Table ' <-- How can I change this part???
Case TabHead
'do some stuff with strText
'Case AnotherTable1
'Case AnotherTable2
'...
end select
end if
end select
next oRevision
My main goal is to track down all changes in word document, get date and time and user of that change. By I need to know where that change was made. Tracked change function can give me all that detail, but how to determine where that change was made?
Through the Range object, you have acces to all the different objects in the revision. If you want to reference the first Table object then use:
oRevision.Range.Tables(1)
You obviously need to check to see that there are tables before using the reference (e.g If oRevision.Range.Tables.Count > 0 Then ...).
You could also access the bookmarks collection in the same way:
If oRevision.Range.Bookmarks.Count > 0 Then
Debug.Print oRevision.Range.Bookmarks(1).Name
End If
This gives you the table number of Selection.
Sub Demo()
Dim iTable&
With Selection
If Not .Information(wdWithInTable) Then
MsgBox "The selection is not in a table!"
Exit Sub
End If
For iTable = 1 To ActiveDocument.Tables.Count
If (.Range.Start >= ActiveDocument.Tables(iTable).Range.Start) And _
(.Range.End <= ActiveDocument.Tables(iTable).Range.End) Then
Exit For
End If
Next iTable
End With
MsgBox "It's in table # " & iTable
End Sub
From macropod https://groups.google.com/forum/#!searchin/microsoft.public.word.programming/%22table%22$20which/microsoft.public.word.programming/Gid7abgeAek/c5rUWhFmWwgJ