WORD VBA to INSERT text after a list - vba

At the end of our a Word2010 document we've a numbered list of 6 items. We would like to add a text, say, End of Document at the end of that document using VBA. But when I try the following code it always add a new list item (item 7) to the list with that text as shown in image below. NOTE: We don't have control over the document. So the last line of the document is always item number 6 of the list and when a user runs VBA code the code is supposed to add last line at the end of the document as End of document. And this line should not be the last item of the list.:
Sub test()
Dim oList As List
Set oList = ActiveDocument.Lists(1)
oList.Range.InsertParagraphAfter
oDoc.Content.InsertAfter "End of Document";
End Sub
Snapshot of the list at the End of a document:

Since you want to insert at the end of the document, you dont even need to find the list, this should do:
With ActiveDocument.Content
.InsertParagraphAfter
With .Paragraphs(.Paragraphs.Count).Range
.InsertAfter "End of Document"
.Style = wdStyleNormal
End With
End With

Related

How to reset style in VBA after adding a hyperlink in word

I am using code that I have adapted from here https://wordribbon.tips.net/T000672_Making_Hyperlinks_from_Coded_Text.html to automatically generate hyperlinks in word based on matched text.
I have an issue though, I would like to preserve the original formatting (style) of the selection. The key part of the code which I am trying to get to work is:
Dim my_hyperlink As Hyperlink
Dim curStyle As Object
...
... ' find the text I want to match now apply hyperlink
With Selection
curStyle = .Style
Set my_hyperlink =ActiveDocument.Hyperlinks.Add(Anchor:=Selection.Range,_
Address:="https://example.com",SubAddress:="")
my_hyperlink.Range.Style = curStyle
End With
I am trying to store the current style in curStyle, apply the hyper link and then reset the style.
I am getting the error though "object variable or with block variable not "
Is there some trick to store the style apply hyperlink and then restore the original style?
I can offer two options to do it
Modifying Hyperlink style (once)
Reset font style (after)
Sub OldStyleHyperlinkStyleChange()
Dim my_hyperlink As Hyperlink
'...
'... ' find the text I want to match now apply hyperlink
With ActiveDocument.Styles(wdStyleHyperlink).Font
.ColorIndex = wdAuto
.Underline = wdUnderlineNone
End With
With Selection
Set my_hyperlink = ActiveDocument.Hyperlinks.Add(Anchor:=.Range, _
Address:="https://example.com", SubAddress:="")
End With
End Sub
Sub OldStyleReset()
Dim my_hyperlink As Hyperlink
'...
'... ' find the text I want to match now apply hyperlink
With Selection
Set my_hyperlink = ActiveDocument.Hyperlinks.Add(Anchor:=.Range, _
Address:="https://example.com", SubAddress:="")
my_hyperlink.Range.Font.Reset
End With
End Sub

Copy text and picture into new word document

In the active word document I have a macro which extracts a text string and all images from the document.
I want to copy this text and the picture in a new blank word document.
I tried the following
Dim docNew As Document
Set docNew = Documents.Add
With ThisDocument
...
docNew.Content.Text = docNew.Content.Text & vbCrLf & sSentence
For Each iShape In .InlineShapes
iShape.Select
Selection.CopyAsPicture
docNew.Content.Paste
Next iShape
End With
When I execute this code, first the text is copied correctly to the new blank document. But when the picture is pasted, it overwrites the text and only the picture remains in the document.
How do I have to modify the code so that the text as well as all pictures are included?
As you would have discovered from looking at the help text .Content represents the whole of the main body of the document.
Assuming you want to add the pictures at the end of the document, replace
docNew.Content.Paste
with
With docNew.Content
.InsertParagraphAfter
.Paragraphs.Last.Range.Paste
End With

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

Is there a way to list broken internal hyperlinks with VBA in MS Word? (Hyperlink Subaddress)

In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub

Macro to update all fields in a word document

I have built - over the years - a vba macro that is supposed to update all fields in a word document.
I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.
Currently - it look like this:
Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
Dim doc As Document ' Pointer to Active Document
Dim wnd As Window ' Pointer to Document's Window
Dim lngMain As Long ' Main Pane Type Holder
Dim lngSplit As Long ' Split Type Holder
Dim lngActPane As Long ' ActivePane Number
Dim rngStory As Range ' Range Objwct for Looping through Stories
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities 'Table of Authorities Object
Dim TOF As TableOfFigures 'Table of Figures Object
Dim shp As Shape
' Set Objects
Set doc = ActiveDocument
Set wnd = doc.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
If rngStory.StoryType <> wdMainTextStory Then
While Not (rngStory.NextStoryRange Is Nothing)
Set rngStory = rngStory.NextStoryRange
rngStory.Fields.Update
Wend
End If
End If
Next
For Each shp In doc.Shapes
If shp.Type <> msoPicture Then
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
End If
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
' Header and footer too.
UpdateHeader
UpdateFooter
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Sub UpdateFooter()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Footer
For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
footer.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
'Update only the fields in your footer like:
Sub UpdateHeader()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Header
For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
header.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
I have noticed recently that it sometimes misses some sections of the document. Today it missed First page footer -section 2- (the document version was not updated).
I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.
To test, create a word document and add a custom field named Version and give it a value. Then use that field {DOCPROPERTY Version \* MERGEFORMAT } in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.
Edit
The challenging document that seems to cause the most problems is structured like this:
It has 3 sections.
Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version property on it. Subsequent pages have page numbering in roman numerals for the TOC.
Section 2 is for the body of the document and has headers and footers.
Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.
All footers contain the Version custom document property.
My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.
For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.
Public Sub UpdateAllFields()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
On Error Resume Next
rngStory.Fields.Update
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Fields.Update
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
Some research and experimentation produced the following addition which seems to solve the additional problem of updating the headers/footers in a multi-section document.
Add the following dimensions to the earlier answer:
dim sctn as Word.Section
dim hdft as Word.HeaderFooter
And then, add to the earlier code
for each sctn in doc.Sections
for each hdft in sctn.Headers
hdft.Range.Fields.Update
next
for each hdft in sctn.Footers
hdft.Range.Fields.Update
next
next
However - I am still not happy with this code and would very much like to replace it with something less hacky.
Thanks for these answers! I found the answers very good and learned some stuff about ms-word macros. I thought I'd make my own answer for consideration (and adding some more search engine keywords - my searches didn't bring me here immediately).
I took inspiration from the citations in the footnotes.
I had an issue where MS Word fields were not updating in Textbox (Shapes).
I was working on a 70 page word document (Word 2013) that contained a lot of figures/images/captions and cross-references. A common practice is for an image to be captioned e.g. Figure 7, so it can be easily cross-referenced. Often the caption is inside a textbox (shape) and grouped with/to the object its captioning.
So after some document editing and content reorganisation, the fields and cross-references can easily get out of logical sequence.
OK - no problem... pressing CTRL+A then F9 to update the document fields should solve this?
Unfortunately that didn't work as expected to update fields in textboxes (shapes).
In this scenario where fields exist inside textboxes (shapes) CTRL+A then F9 only updated the fields not inside a textbox (shape).
One can assume this behaviour is because field updating (F9) works on selected text, and with the CTRL+A then F9 approach only text outside of the textboxes (shapes) is selected, so the field update only applies outside of textboxes (shapes).
I'm surprised there is not a button on the ribbon to perform an "update all fields". There could even be a toggle option to prompt the user to update all fields when closing a document?
I checked Word's (2013) ribbon command list, and didn't find an Update All command.
Solution UpdateAllFields()
Like the code shared by #Cindy here, the following code should update fields wherever they are in the doc, header, footer, main doc, textbox, grouped and nested grouped textbox.
Create a macro with the following code, and then add to the Quick Access Toolbar (QAT)
Press ALT+F8 to open the Macros dialogue.
Enter a name for the Macro: UpdateAllFields
Press Create button
Paste the code:
Sub UpdateAllFields()
Application.ScreenUpdating = False
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Finally add the Macro to the Quick Access Toolbar.
Citations and inspirations:
The Q&A's in this post!
There is a related post on the Microsoft Community here: Word 365 Fields not updating in Textbox [serious reproducible error]. This suggests the issue is present in at least Word 2013 and Word 365.
There is a related post on Stack Overflow here: Macro to update fields in shapes (textboxes) in footer in Microsoft Word.
Another example UpdateTextboxFields()
This was the first version of code I wrote as I was in research and solution mode. Its a recursive approach to update fields inside textboxes, even if they are inside a group, or nested group. This doesn't update fields outside shapes.
Public Sub UpdateTextboxFields()
Application.ScreenUpdating = False
With ActiveDocument
Call IterateShapesCollection(.Shapes)
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Private Sub IterateShapesCollection(col)
Dim shp As Shape
For Each shp In col
' https://learn.microsoft.com/en-gb/office/vba/api/office.msoshapetype
' Ignore images and
If 1 = shp.Type Or 13 = shp.Type Then
GoTo NextIteration
End If
'Debug.Print ("Name: " & shp.Name & ", Type: " & shp.Type)
' if the type is a group, recurse
If 6 = shp.Type Then
Call IterateShapesCollection(shp.GroupItems)
Else
Call UpdateShapeFields(shp)
End If
NextIteration:
Next
End Sub
Private Sub UpdateShapeFields(shp)
With shp.TextFrame
If .HasText Then
.TextRange.Fields.Update
End If
End With
End Sub
Word display option: Update fields before printing
cite: Microsoft article Some fields are updated while other fields are not
The concept behind this option/approach is: all document fields are updated when you open print preview.
It looks like this option in Word (tested in 2013) updates all fields with a caveat - see below - you may need to open and close print preview twice.
File → Options → Display → Print options section → Update fields before printing
Caveat if the doc has cross-references to figures/captions
This caveat applies to the word "Update fields before printing" display option and the UpdateAllFields() macro.
IF the document contains cross-references to figures/captions (with numbers), and those figures/captions have changed sequence/place in the document...
You must update the fields twice, 1) to reflect the figures/captions update, and then 2) to update the cross-references.