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).
Related
Within a Word docx: I'm trying to add a bookmark to each sentence. For example, at first sentence would be bookmark "bmarkpg01" and second sentence would be bookmark ""bmarkpg01ln01col01"". My code adds only one bookmark to first sentence and doesn't loop through to end of document.
I've tried a for each loop to attempt each sent in sentences and each bmark in bookmark.
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
For Each bmark In ActiveDocument.Bookmarks
ActiveDocument.Bookmarks.Add Name:="pmark" & bmark.Range.Information(wdActiveEndAdjustedPageNumber), Range:=myRange 'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
Next
End Sub
EXPECTED RESULT: Within entire document, each sentence has a corresponding bookmark and bookmark name ("bmarkpg01ln01col01", "bmarkpg01ln02col10", etc.)
ACTUAL RESULTS: only one bookmark is added to the first sentence of the document.
The following works for me, as far as the requirements in the question go.
Please remember to put Option Explicit at the top of a code page. This will force you to declare ("Dim") variables, but will also save time and trouble as it will prevent typos and warn you of other problems.
A Sentence in Word returns a Range object, so the code below delares MySent As Range. This provides the target Range for the Bookmarks.Add method.
If you won't be doing anything else with the bookmark, it's not strictly necessary to Set bkm = when adding the bookmark. I left it in since it is declared in the code in the question.
It's not necessary to loop the collection of bookmarks - espeicially since there aren't any - they're being added.
I've added some code for naming the bookmarks, as well.
Sub tryAddBmarkatSentence()
Dim doc As Word.Document
Dim MySent As Word.Range
Dim bmark As Bookmark
Application.ScreenUpdating = False
Set doc = ActiveDocument
For Each MySent In doc.Sentences
Set bmark = doc.Bookmarks.Add(Name:="bmark" & _
MySent.Information(wdActiveEndAdjustedPageNumber) & "_" &_
MySent.Information(wdFirstCharacterLineNumber) & "_" & _
MySent.Information(wdFirstCharacterColumnNumber), Range:=MySent)
'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
End Sub
u can try like this
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
ActiveDocument.Bookmarks.Add ... and the rest of the code.
//i dont know how you define witch bookmark is to asign to that sentence
Next
End Sub
I'm struggling a bit with CheckSpelling in Excel. I have a merged cell that I want to check, but only this cell. Here's what I'm doing.
ActiveSheet.Unprotect strSheetPassword
Application.DisplayAlerts = False
Set ma = Range("B21").MergeArea
ma.MergeCells = False
Union(Range("B1"), ma(1, 1)).CheckSpelling
ma.MergeCells = True
Application.DisplayAlerts = True
ActiveSheet.Protect strSheetPassword
It's checking the cell I want, but it's also checking the rest of the document. In reading other posts, I got the impression that checking a single cell causes CheckSpelling to check the entire document. This is why I put in the Union with the Range("B1") - B1 contains header text that doesn't have any misspellings and is normally locked, so that users can't change it. But, it is still checking the rest of the sheet! I've tried quite a few variations on this, but it still keeps checking the rest of the sheet.
CONCLUSION
I had been under the impression that it was possible to invoke the CheckSpelling form and have it only check certain cells. Apparently, this isn't true. Instead of building my own form, I should be able to get away with checking the whole sheet each time, although I really don't like that. Thanks for all the feedback!
For a single merged cell:
Sub spell_me()
Dim b As Boolean
b = Application.CheckSpelling(Word:=ActiveCell.Text)
MsgBox b & vbCrLf & ActiveCell.Address & vbCrLf & ActiveCell.Text
End Sub
EDIT#1:
To find the miscreant word, you could Split() the text into individual words and check each word.
If it is enough if the wrong part gets highlighted you can use this:
Sub SpellCheck()
Dim response As Boolean
Dim words As Variant
Dim wordCount As Long
Dim startAt As Long
words = Split(ActiveCell.Text, " ")
'set all of the text to automatic color
ActiveCell.Font.ColorIndex = xlAutomatic
For wordCount = LBound(words) To UBound(words)
response = Application.CheckSpelling(word:=words(wordCount))
If Not response Then
'find out where it is in the text and color the font red
startAt = InStr(ActiveCell.Text & " ", words(wordCount) & " ")
ActiveCell.Characters(Start:=startAt, Length:=Len(words(wordCount))).Font.Color = vbRed
End If
Next
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.
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 am using the following VBA macro to add page numbers after all bookmark hyperlinks in my document:
Sub InsertPageRefs()
Application.ScreenUpdating = False
Dim hLnk As Hyperlink, Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
With hLnk
If InStr(.SubAddress, "_Toc") = 0 And .Address = "" Then
Set Rng = .Range
With Rng
.Collapse Direction:=wdCollapseEnd
.InsertAfter Text:=" (See page #)"
.Font.Underline = wdUnderlineNone
End With
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), Text:="PAGEREF " & .SubAddress
End If
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
However, it's having undesirable results.
The blue color of the hyperlinks is partially spilling over into the added text.
It's creating a bunch of crazy span tags when I save the resulting file to HTML. I don't want this because I am going to convert the HTML to .mobi for Kindle and all the span tags are going to create chaos in my .mobi.
How do I strip out all the formatting and insert the page numbers in the "Normal" word style?
I suspect the real answer for this would be to use a good e-book editor that will keep track of this for you.
That said, the problem is likely that you are working on the Hyperlink's range, so all you should have to do is duplicate it. This allows the formatting of your range separate itself from whatever formatting is attached to the hyperlink. The other benefit of using a duplicate of a Hyperlink's range is that you can operate on the text of the range directly without destroying the link, which is also an easy way to preserve the target formatting:
Sub InsertPageRefs()
Dim hLnk As Hyperlink
Dim Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
If InStr(hLnk.SubAddress, "_Toc") = 0 And hLnk.Address = vbNullString Then
Set Rng = hLnk.Range.Duplicate
Rng.Start = Rng.End
Rng.Text = " (See page #)"
Rng.Font.Underline = wdUnderlineNone
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), _
Text:="PAGEREF " & hLnk.SubAddress
End If
Next
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
Note that I pulled out the With blocks to make this more readable. Nested Withs make it a lot more difficult to tell at a glance what object you're operating on.