I have the following code to insert a textbox into a word document:
Sub mark()
Dim Box As Shape
Set Box = ActiveDocument.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=20, Width:=20, Height:=20)
Box.TextFrame.TextRange.Text = "tick"
End Sub
The text inside the texbox needs to be:
Selection.InsertSymbol Font:="Wingdings", CharacterNumber:=-3844, Unicode :=True
I see you've found an answer, but there's a more optimal way to use the method you found. Since it's not possible to format code nicely in Comments I'm writing it up in the Answer space for you (and others who might have the same question). Also, the site prefers the useful information to be in an "Answer" since Comments tend to be over-looked or deleted...
In order to insert content from the Insert Symbol dialog box, use the InsertSymbol method, which applies to either the Range or the Selection`object.
Using the Rangeobject is always the preferred approach. In order to get a Range object for the text box content, adjust your code something like this:
Sub mark()
Dim Box as Word.Shape
Dim rngBox as Word.Range
Set Box = ActiveDocument.Shapes.AddTextBox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=20, Top:=20, Width:=20, Height:=20, _
Set rngBox = Box.TextFrame.TextRange
rngBox.Text = "tick"
rngBox.Collapse wdCollapseEnd 'focus at end of Range
rngBox.InsertSymbol Font:="Wingdings", CharacterNumber:=-3844, Unicode:=True
End Sub
The Collapse method allows you to continue adding text (optionally with formatting) for as long as you require...
Related
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 developing a spreadsheet to automatically generate quotes; this involves copying the correct diagram (a grouped Excel shape) from a sheet with a library of our possible diagrams, and pasting/inserting/[whatever will work best] that image into the VBA-assembled Word document.
So far, I am able to successfully identify, copy and paste special the correct diagram shape from Excel into Word. However, every technique I have found means that the shape either wraps text as inline or infront-- whereas I need the next portion of text to be directly aside the diagram-- thus "wdTight"
Below, you can see how I paste in the current shape. But I can't figure out how to make that shape into ".wrapFormat.Type = wdTight"
I am generally met with a series of Runtime 438 errors: object doesn't support this property or method.
I have a theory that this is because Word considers the selection to always be the blinking text cursor, and not the just pasted shape which is activated and has a hovering layout options tooltip (but that is just a theory).
Here is the code. Please help.
Sub export_excel_to_word()
Dim appWord
Dim quoteWord
Dim wordSelection
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Set quoteWord = appWord.Documents.Add
Set wordSelection = appWord.Selection
'This part works
Module1.ImagesRefresh
'Product 1 image insertion
Sheets("Quick Lookup").Shapes("QuoteProduct1Image").Copy
wordSelection.PasteSpecial Link:=False, _
DataType:=wdPasteShape, _
Placement:=wdInLine, _
DisplayAsIcon:=False
'This part does not work and is where I need help
With wordSelection
.WrapFormat.Type = wdWrapFront
End With
Try creating a variable to represent the newly pasted shape, it should be accessible by index, and should be the last index:
'Product 1 image insertion
ActiveSheet.Shapes(1).Copy
wordSelection.PasteSpecial Link:=False, _
DataType:=wdPasteShape, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Dim wdShape As Word.Shape
Set wdShape = quoteWord.Shapes(quoteWord.Shapes.Count)
wdShape.WrapFormat.Type = wdWrapTight
Without using the shape variable, this might also work, but I have not tested against a document with several shapes (assuming you're adding shapes in sequence/iteration)
'Product 1 image insertion
ActiveSheet.Shapes(1).Copy
wordSelection.PasteSpecial Link:=False, _
DataType:=wdPasteShape, _
Placement:=wdInLine, _
DisplayAsIcon:=False
wordSelection.ShapeRange(1).WrapFormat.Type = wdWrapTight
If you're also inserting text (e.g., through the TypeText method of a Word.Range, try the code below. I'm not super-familar with Word automation, and the rule that you should avoid activate/select I think is less strict in Word (or has more exceptions) but as a rule of thumb, I'd still try to avoid reliance on the Selection object, and work with ranges instead.
What I'm doing here is pasting to the wordSelection.Range rather than the Selection itself. Then I do
ActiveSheet.Shapes(1).Copy
wordSelection.Range.PasteSpecial Link:=False, _
DataType:=wdPasteShape, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Dim wdShape As Word.Shape
Set wdShape = quoteWord.Shapes(quoteWord.Shapes.Count)
wdShape.WrapFormat.Type = wdWrapTight
wordSelection.TypeText "some text"
I am writing a macro to insert a textbox containing a pre-formatted table into a Microsoft Word document, and I want it to insert the table at the current cursor location. With the current code I have, the textbox seems to be inserted at the beginning or end of the current page, instead of the cursor location.
Here is my code:
Sub InsertTable()
Dim shpTbox As Shape
Dim rngTbox As Range
Dim tblBox As Table
Set shpTbox = ActiveDocument.Shapes.addtextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=72, Top:=50, Width:=468, Height:=220, Anchor:=Selection.Range)
shpTbox.TextFrame.TextRange.Tables.Add Range:=shpTbox.TextFrame.TextRange, NumRows:=8, NumColumns:=4, _
DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
shpTbox.TextFrame.TextRange.Tables.Item(1).Select
shpTbox.TextFrame.TextRange.Tables(1).Style = ActiveDocument.Styles("Custom Table")
Selection.InsertCaption Label:="Figure", _
Title:=". Insert Caption Here", _
Position:=wdCaptionPositionBelow
shpTbox.Line.Visible = msoFalse
shpTbox.WrapFormat.Type = wdWrapSquare
shpTbox.WrapFormat.Side = wdWrapBoth
shpTbox.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
Is there a way to do what I want to do? Can someone explain why this doesn't do what I want it to do?
Thank you!
Word positions to the page by default. You need to tell it otherwise, and re-set the Left and Top properties afterwards. After the TextBox has been inserted specify the relative horizontal and vertical positions. For example:
shpTbox.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
shpTbox.RelativeVerticalPosition = wdRelativeVerticalPositionLine
shpTbox.Left = 72
shpTbox.Top = 50
You may want to test some of the WdRelativeHorizontalPosition and WdRelativeVerticalPostition enumeration values to see what works best for your situation.
I am able to populate a bookmarked location on a Word Document from user input via a UserForm.
What I would like to do is convert the text entered into a Hyperlink.
The following snippit of code was used to insert the text into the appropriate location:
Private Sub CommandButton1_Click()
Dim benchmarkURL As Range
Set benchmarkURL = ActiveDocument.Bookmarks("benchmark").Range
benchmarkURL.Text = Me.benchmarkURLTextBox.Value
ActiveDocument.Bookmarks.Add "benchmark", benchmarkURL
Me.Repaint
'Update the fields to populate the references of the bookmarks
UpdateAllFields
UserForm1.Hide
End Sub
I tried the following which did not work:
Private Sub CommandButton1_Click()
Dim benchmarkURL As Range
Set benchmarkURL = ActiveDocument.Bookmarks("benchmark").Range
benchmarkURL.Text = Me.benchmarkURLTextBox.Value
Hyperlinks.Add(ActiveDocument.Bookmarks.Add "benchmark", benchmarkURL)
Me.Repaint
'Update the fields to populate the references of the bookmarks
UpdateAllFields
UserForm1.Hide
End Sub
Any advice will be much appreciated
Thanks in advance
Hyperlinks.Add(ActiveDocument.Bookmarks.Add "benchmark", benchmarkURL)
There are at least two things wrong with this line, possibly more depending on what it is you want the hyperlink to link to.
You have omitted the parent object for the Hyperlink which should be ActiveDocument.
There should not be any brackets as the return value of
Hyperlinks.Add is not being assigned to anything.
You can find further info here: https://msdn.microsoft.com/en-us/library/office/ff837214(v=office.15).aspx
I found a better solution. For those that need, it is posted below:
'URL of Benchmark Data
Dim benchmarkURL As Range
Set benchmarkURL = ActiveDocument.Bookmarks("benchmark").Range
benchmarkURL.Text = Me.benchmarkURLTextBox.Value
ActiveDocument.Hyperlinks.Add Anchor:=benchmarkURL, Address:= _
benchmarkURL.Text, SubAddress:="", ScreenTip:="", TextToDisplay:= _
"Benchmark Data"
Just to provide some further description to Jame's answer.
'URL of Benchmark Data
Dim benchmarkURL As Range
Set benchmarkURL = ActiveDocument.Bookmarks("benchmark").Range
benchmarkURL.Text = Me.benchmarkURLTextBox.Value
ActiveDocument.Hyperlinks.Add Anchor:=benchmarkURL, Address:=benchmarkURL.Text, SubAddress:="", ScreenTip:="", TextToDisplay:="Benchmark Data"
means put this information in.
'URL of Benchmark Data
ActiveDocument.Hyperlinks.Add Anchor:=<<Where link will display>>, Address:= <<Where the link will go to>>, SubAddress:="", ScreenTip:="", TextToDisplay:="<<what the link text should say"
This is my working version. In my instance I take text like this AC-2 in a table cell and make a bookmark with AC2. One table with AC-2 clicks to another table with AC-2 that is bookmarked.
'/////////////
Set benchmarkURL = oDoc.Bookmarks(strText2).Range
With oDoc.Tables(r).Cell(i, 1)
.Range.Hyperlinks.Add Anchor:=oDoc.Tables(r).Cell(i, 1).Range, Address:="", SubAddress:=strText2, ScreenTip:="", TextToDisplay:=strText
End With
I have a lot of lists in my document with numbers that look like "1.3.2" and I want to automate the process of creating a cross-references to the list elements.
I'm trying to make a macro that will:
detect the list element, cursor is positioned at;
create a cross reference to the list element with number as a reference text (i.e. "1.3.2");
put it into the clipboard;
make "LCtrl+C" hotkey launch that macro when cursor is positioned at the list number (optional: only for the lists with declared style(s)).
How do I achieve that with VBA?
After looking at the object model and how Word behaves I think you can manage something, but perhaps not exactly the way you envisioned. The problem lies with the Numbered Items, which seem to be oriented to captions rather than numbered lines... In any case, when a cross-reference is inserted via the dialog box to a "Numbered item" Word does create a bookmark and then reference that. So my suggestion emulates that behavior, as in the following code snippet.
What you'll need/want to do is maintain a "counter" for incrementing the bookmark name (or you could generate GUIDs, the way Word does). My demo has the bookmark name hard-coded.
This example sets the hidden bookmark at the beginning of the paragraph where the current selection is. It then inserts a cross-reference, extends the Range to include the cross-reference (since the method does not return a range or object) and cuts it to the clipboard. The user can then paste it wherever he wants.
Sub InsertThenCopyCrossRef()
Dim rng As word.Range, rngBkm As word.Range
Dim bkm As word.Bookmark
Dim sMyRef As String
sMyRef = "_MyRef_1" 'a counter or something to make name unique!
Set rng = Selection.Range
Set rngBkm = rng.Duplicate.Paragraphs(1).Range
rngBkm.Collapse wdCollapseStart
Set bkm = ActiveDocument.Bookmarks.Add(sMyRef, rngBkm)
rng.InsertCrossReference wdRefTypeBookmark, wdNumberFullContext, sMyRef
rng.MoveEnd wdWord, 1
rng.Fields(1).Cut
'rng.Select
End Sub
I've tinkered around for the fun of it and long story short: I don't think you will manage to do that. Reason: this is the code for creating a cross reference to a numbered item in VBA:
Set r = Selection.Range
r.InsertCrossReference ReferenceType:="Numbered item", _
ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="5", _
InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
SeparatorString:=" "
Trouble here is the ReferenceItem:="5". When I recorded this, it was simply the fifth numbered item regardless of its list level.
So all you have to do now is to find a way to identify a numbered item as the nth numbered item in your document.
If you can solve that, you can assign a key combination to copy a reference to the current list item like this:
Sub CopyReference()
Dim r As Range
Dim dObject As DataObject
Set dObject = New DataObject
Set r = Selection.Range
r.InsertCrossReference ReferenceType:="Nummeriertes Element", _
ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="5", _
InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
SeparatorString:=" "
dObject.SetText r.Paragraphs(1).Range.Fields(1).Code
r.Paragraphs(1).Range.Fields(1).Delete
dObject.PutInClipboard
End Sub
And another key combination to paste your reference like this:
Sub pasteField()
Dim fld As Field, dObject As DataObject
Dim gg
Set fld = ActiveDocument.Fields.Add(Selection.Range, wdFieldRef)
Set dObject = New DataObject
dObject.GetFromClipboard
gg = dObject.GetText
fld.Code.Text = gg
fld.Update
End Sub
As you can see, I haven't actually copied the cross reference field but only its code.