Generate bookmarks in Word 2010 programmatically, with the header name as the bookmark name - vba

I need to generate bookmarks in Word 2010 programmatically, with the header name as the bookmark name.
I have the following code which makes a word a bookmark, but the bookmark name remains the same as the string Heading 1 is only available in the name variable:
Sub bookmarking()
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=" Heading 1"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
End Sub
Instead of the Heading 1 in the name variable, I want content from the clipboard. Please help me replace that Heading 1 with clipboard content.

Use a DataObject from the Microsoft Forms 2.0 Object Library:
Private Function GetClipboardData()
Dim objDataObject As MSForms.DataObject ''need to add reference in Tools |References
Set objDataObject = New MSForms.DataObject
objDataObject.GetFromClipboard
On Error Resume Next
GetClipboardData = objDataObject.GetText
If Err.Number = -2147221404 Then
MsgBox "Error: current clipboard data is either empty or is not text. Clibpoard must contain text."
End If
End Function
Then, back your main code, have the bookmark name be this clipboard data:
...
.Add Range:=Selection.Range, Name:=GetClipboardData()
...
Is this a good start for you? There are other ways which may be more robust depending on your needs. However this should serve as good proof-of-concept.

Related

MS Word: Getting the actual ASCII code of an inserted symbol

I am trying to write a VBA code for MS-Word to remove rows with the unticked symbol from a table.
To do that, I need MS-Word to recognize it and differentiate between it and the ticked symbol. But unlike Excel, MS-Word seems to be bad at it.
To focus on the problem, I inserted the symbols, but I can not get the correct ASCII code of the character I have just inserted.
Here is what I tried:
Sub SymbolsTest()
Selection.InsertSymbol 163, "Wingdings 2", True 'Insert unticked
Selection.MoveRight Unit:=wdCharacter, Count:=-1, Extend:=wdExtend 'Select it
Debug.Print AscW(Selection.Text) & " " & Selection.Text 'Ask for ASCII
Selection.Collapse 0
Selection.InsertSymbol 82, "Wingdings 2", True 'Insert ticked
Selection.MoveRight Unit:=wdCharacter, Count:=-1, Extend:=wdExtend 'Select it
Debug.Print AscW(Selection.Text) & " " & Selection.Text 'Ask for ASCII
End Sub
The output is:
40 (
40 (
I would expect it to be:
163 ?
82 ?
I also tried ?Selection.Characters(1) = Selection.Characters(2) in the immediate window while selecting both of them, and I got True
Any help would be appreciated.
As far as I know
there is no simple way to get the character's code point or font name directly using any of the properties of the Selection or Range
In this situation, Word always uses the code point 40 (")"), and internally, it does does store the name of the font you specified and a Unicode codepoint (e.g. U+F052 for the checked box).
Two things you can do. If the character is not 40, assume it already has the correct codepoint (although I am not certain about that). But if not,
retrieve the .XML or .WordOpenXML of the Selection or Range and look for the relevant element, e.g. ><w:sym w:font="Wingdings 2" w:char="F052"/> in both the old-style .XMLand the newer .WordOpenXML. You could either search for the text <w:sym and look for the font and codepoint in the following text, or "do it properly" using an XML parser. In that case, it may be useful to know that F052 either means "the Unicode character with code point F052, or it means "it's F000 + the code point in the original character set", i.e. Wingdings 2 in this case.
e.g. one way would be to make a reference in the VB Editor's Tools-References to the Microsoft XML library (in this case 6.0) and use code along these lines:
Sub getCharFontAndCodepoint()
Dim xdoc As MSXML2.DOMDocument60
Dim xSymNodes As MSXML2.IXMLDOMNodeList
Set xdoc = New MSXML2.DOMDocument60
xdoc.async = False
If xdoc.LoadXML(Selection.XML) Then
xdoc.SetProperty _
"SelectionNamespaces", _
"xmlns:w='http://schemas.microsoft.com/office/word/2003/wordml'"
Set xSymNodes = xdoc.SelectNodes("//w:sym/#w:font")
If xSymNodes.Length > 0 Then
Debug.Print xSymNodes(0).NodeValue
End If
Set xSymNodes = xdoc.SelectNodes("//w:sym/#w:char")
If xSymNodes.Length > 0 Then
Debug.Print xSymNodes(0).NodeValue
End If
End If
Set xSymNodes = Nothing
Set xdoc = Nothing
End Sub
or, if you only need the codepoint, copy the character and use paste special to paste it using the Unformatted Unicode Text format, e.g.
Selection.Copy
Selection.PasteSpecial link:=False, DataType:=22 ' There does not seem to be a named enum for this particular format
Selection.MoveLeft Unit:=WdUnits.wdCharacter, Count:=1, Extend:=WdMovementType.wdExtend
Debug.Print Hex(AscW(Selection))
Selection.Document.Undo

Making links to Places in this document work in vba

I'm trying to make a VBA script that will take all the headings in a document and make a table of contents out of them, with hyperlinks to each of the headings. The headings are all found, parsed and all the hyperlinks are made, however they don't correctly reach their destination which is a place within the document. The default 'create hyperlink to Place in this document' code looks like this:
Selection.Range.Hyperlinks(1).Range.Fields(1).Result.Select
Selection.Range.Hyperlinks(1).Delete
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="_Test_Heading"
Selection.Collapse Direction:=wdCollapseEnd
This is the code that you would get if you recorded a macro while using the 'Edit hyperlink' window.
Edit hyperlink window
The address field where normally there would be a URL is empty, while the subaddress field is filled by the name of the header with underscores.
I think the problem is that Word defaults to 'Existing file or web page' rather than 'Place in this document', even if 'Place in this document' were specified prior. If I switch the mode of a link to 'Place in this document' without changing the subaddress or anything else, it works - but having to go and do that for each link defeats the purpose of the script. I've been looking all over for a way to express 'Place in this document' in VBA but haven't found anything. Tried bookmarks as an alternative and that didn't work either. Any help would be appreciated.
I found a workaround using cross-referencing. In case it helps anyone in the future:
Private Function GetLevel(strItem As String) As Integer
Dim strTemp As String
Dim strOriginal As String
Dim longDiff As Integer
strOriginal = RTrim$(strItem)
strTemp = LTrim$(strOriginal)
longDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (longDiff / 2) + 1
End Function
Sub TableofContents()
Dim i As Integer
Dim AllHeadings As Variant
AllHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine
For i = LBound(AllHeadings) To UBound(AllHeadings)
strtext = Trim$(AllHeadings(i))
Level = GetLevel(CStr(AllHeadings(i)))
If Level = 2 Then
Selection.InsertCrossReference ReferenceType:="Heading", ReferenceKind:= _
wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True, _
IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
Selection.TypeParagraph
End If
Next
End sub
The first function gets the level of the heading.
The second part moves to the top of the document and starts inserting cross-references to the headings that I want (in this case I want it to be = 2).

I'm trying to create a simple userform that adds and deletes a block of text in Word

I have a userform with a bunch of checkboxes. I want the VBA code to add a block of text (defined as a variable) if the checkbox is true and remove that block of text if it gets unchecked. As an example, this is what I have for one of the checkboxes:
Private Sub CheckBox1_Click()
Dim Text1 As String
Text1 = "Text test"
If CheckBox1.Value = True Then
Selection.TypeText Text:=Text1
Selection.InsertParagraph
End If
If CheckBox1.Value = False Then
Selection.Delete Text:=Text1
End If
End Sub
First of all, the Selection.Delete Text:=Text1 part is completely wrong. I've tried to google something similar and have been unable to find anything that deletes the content of a variable.
Second of all, there seems to be an error with the Selection.InsertParagraph code. I want it to add a new paragraph between each block of text/variable, however with the way that the code is now, it adds the text block and the paragraphs separately like this if I were to activate the macro 3 times:
Text testText testText test
(new paragraph)
(new paragraph)
(new paragraph)
What I want instead is this:
Text test
(new paragraph)
Text test
(new paragraph)
Text test
(new paragraph)
Answering the first question, for which there is sufficient information to provide an answer...
The best control of where something is inserted and foramtted in a Word document is to use Range objects. There can be only one Selection, but code can work with multiple Ranges.
For inserting a new paragraph immediately following text it's possible to append the new paragraph at the end of the text using the ANSI 13 character, which can be represented in VBA code using vbCr.
Example:
Private Sub CheckBox1_Click()
Dim Text1 As String
Dim rngTarget as Range
Text1 = "Text test"
Set rngTarget = Selection.Range
If CheckBox1.Value = True Then
rngTarget.Text = Text1 & vbCr
End If
'
'If CheckBox1.Value = False Then
' Selection.Delete Text:=Text1
'End If
'''Move to the end of the range and select that for the next iteration
rngTarget.Collapse wdCollapseEnd
rngTarget.Select
End Sub

How to display quick part > document property in word using macro?

I have two custom column in quick part mapped from sharepoint edit template.
DocSigner and DSigneromment
Now i have write macro code in word for get all builtinproperties and custom properties. I am able to get all built in document properties like Author ,Title and all but not able to get that custom column using "CustomDocumentProperties"..
Here is my macro code..
Sub ListAllProperties()
Dim rngDoc As Range
Dim proDoc As DocumentProperty
Set rngDoc = ActiveDocument.Content
rngDoc.Collapse Direction:=wdCollapseEnd
For Each proDoc In ActiveDocument.CustomDocumentProperties
With rngDoc
.InsertParagraphAfter
.InsertAfter proDoc.Name & "= "
On Error Resume Next
.InsertAfter proDoc.Value
End With
Next
End Sub
So any code changes that i can get all document property from quick part.
To get the values of properties coming from custom SharePoint columns, use the Document's ContentTypeProperties collection.
#bibadia Thanks a lot for your contribution
Here is finally i have tried for custom property and it works...
Sub ListContentTypeProperty()
Dim signer As String
signer = ActiveDocument.ContentTypeProperties.Item("DocSigner")
MsgBox signer
End Sub

Read currently selected line

(this should propably be simple, but somehow i cannot find a solution.)
I simply want to read the current line of my selection into a variable in vba. I do not know the current paragraph. The selection is at the very beginning of the line.
My document looks like this.
First of all I select the first row of the table. Then i move one paragraph up. Now thats the line I want. As you can see in my second img, I only have the first character.
For Each tbl In fileInsertRange.Tables
tbl.Rows(1).Select
' save caption
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
tableCaption = Selection.Text
If you want to store all your tables captions in a variable than try this code. Keep in mind you'd need to use the tableCaption variable right away before it gets overwritten by the next tables caption or add an array to store all of the captions.
Sub get_table_caption()
Dim currentTable As Table
Dim tableCaption As String
'Loop through all tables on active document
For Each currentTable In ActiveDocument.Tables
'Get tables caption and store in a variable called "tableCaption"
currentTable.Select
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
Selection.Expand wdLine
tableCaption = Selection.Text
Debug.Print tableCaption
'Do stuff with the tables caption
Next
End Sub
If you want to continue doing it your way by selecting the first row of the table and finding that tables caption than try this code:
Sub get_table_caption()
Dim tableCaption As String
'Get tables caption and store in a variable called "tableCaption"
Selection.Collapse
Selection.MoveUp WdUnits.wdParagraph, 1
Selection.Expand wdLine
tableCaption = Selection.Text
Debug.Print tableCaption
End Sub
Hope that helps. Good luck.