I want to set up a VBA so that for any document based on a template hidden bookmarks are deleted prior to the document closing. We publish documents on our website. They are written as Word and an API converts them to html. If there are hidden bookmarks they appear as links on the website (the hidden bookmarks convert to html anchors). Currently we remove the bookmarks manual prior to the API, but this is time consuming (we publish 1000s of documents a year) and ineffective (people forget).
I found VBA to remove hidden bookmarks which works and tried to add DocumentBeforeClose as the trigger. But it doesn't work:
Private Sub DocumentBeforeClose(cancel As Boolean)
Dim nBK As Long
With ActiveDocument
For nBK = .Bookmarks.Count To 1 Step -1
If LCase(Left(.Bookmarks(nBK).Name, 3)) = "_hl" Then
.Bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
I went through Visual Basic Window, Normal, Microsoft Word Objects, ThisDocument.
Nothing happens, the hidden bookmarks remain if I close and re-open the document.
I think you need to add this line :
.Bookmarks.ShowHidden = True
Like this it should work :
Private Sub DocumentBeforeClose(cancel As Boolean)
Dim nBK As Long
With ActiveDocument
.Bookmarks.ShowHidden = True
For nBK = .Bookmarks.Count To 1 Step -1
If LCase(Left(.Bookmarks(nBK).Name, 3)) = "_hl" Then
.Bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
This has solved it:
Sub AutoClose()
On Error Resume Next
Dim nBK As Long
With ActiveDocument
.bookmarks.ShowHidden = True
For nBK = .bookmarks.Count To 1 Step -1
If LCase(Left(.bookmarks(nBK).Name, 3)) = "_hl" Then
.bookmarks(nBK).Delete
End If
Next nBK
End With
ActiveDocument.Save
End Sub
Only issue is that it tries to run when you open a document and puts up an error message that there is no active document. 'On error resume next' is to stop that error message
Related
I have VBA code that is protected and I want to distribute the file once all the code runs, however, I want to remove all the macros before I do so that the user is not prompted to "enable" macros when they open the document.
I have this code that works if the project is "unlocked" but of course it will not work if the project is not unlocked.
I want to be able to UNLOCK the project then have the code below run. Again, I know the password.
This is a unique situation in that I have quite a few pieces of code and functions that run to perform a scan of another document. I think copy the results of the scanned document that includes comments and highlighted text into the existing document that contains all the code. I then want to remove all traces of itself so that the saved document contains no VBA or Macros.
Private Sub NothingHere(objDocument As Object)
' deletes all VBProject components from objDocument
' removes the code from built-in components that can't be deleted
' use like this: RemoveAllMacros ActiveWorkbook ' in Excel
' or like this: RemoveAllMacros ActiveWorkbookDocument ' in Word
' requires a reference to the
' Microsoft Visual Basic for Applications Extensibility library
Dim i As Long, l As Long
If objDocument Is Nothing Then Exit Sub
i = 0
On Error Resume Next
i = objDocument.VBProject.VBComponents.Count
On Error GoTo 0
If i < 1 Then ' no VBComponents or protected VBProject
MsgBox "The VBProject in " & objDocument.Name & _
" is protected or has no components!", _
vbInformation, "Remove All Macros"
Exit Sub
End If
With objDocument.VBProject
For i = .VBComponents.Count To 1 Step -1
On Error Resume Next
.VBComponents.Remove .VBComponents(i)
' delete the component
On Error GoTo 0
Next i
End With
With objDocument.VBProject
For i = .VBComponents.Count To 1 Step -1
l = 1
On Error Resume Next
l = .VBComponents(i).CodeModule.CountOfLines
.VBComponents(i).CodeModule.DeleteLines 1, l
' clear lines
On Error GoTo 0
Next i
End With
End Sub
Even after looking through all of similar phrased questions and several search engine results I did not find any answer.
I copy the current word document and change the codebase by removing former modules and rewrite the ThisDocument-component by adding from file. For the context, but most probably skippable:
Public Sub DOCMPublish()
'...msoFileDialogSaveAs...and then...'
Application.Documents.Add ThisDocument.FullName
On Error Resume Next
' unlink fields and finalize content to avoid updates within the archived documents
Dim oFld As field
For Each oFld In ActiveDocument.Fields
oFld.Unlink
Next
' rewrite macros and unload modules
On Error Resume Next
Dim Element As Object
For Each Element In ActiveDocument.VBProject.VBComponents
ActiveDocument.VBProject.VBComponents.Remove Element
Next
rewriteMain ActiveDocument, "ThisDocument", ThisDocument.path & "\Document_Public_DOCM.vba"
' protect content
ActiveDocument.Protect wdAllowOnlyFormFields, Password:="LoremIpsum"
' msoFileDialogSaveAs does not support filetypes, hence forcing extension
DOCMFile = fileSaveName.SelectedItems(1)
DOCMFile = Replace(DOCMFile, ".doc", ".docm")
DOCMFile = Replace(DOCMFile, ".docmx", ".docm")
' the next line saves the copy to your location and name
ActiveDocument.SaveAs2 filename:=DOCMFile, FileFormat:=wdFormatXMLDocumentMacroEnabled
' next line closes the copy leaving you with the original document
ActiveDocument.Close
End Sub
This sub worked properly for that over the last years:
Sub rewriteMain(ByRef Workument, ByVal Module, ByVal Source)
'delete code from ThisDocument/ThisWorkbook
Workument.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1, Workument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
'rewrite from file
With Workument.VBProject
.VBComponents(Module).CodeModule.AddFromFile Source
End With
'delete module
Workument.VBProject.VBComponents.Remove Workument.VBProject.VBComponents("Rewrite")
End Sub
The content of Document_Public_DOCM.vba to be imported is
Option Explicit
Private Sub Document_Close()
ThisDocument.Saved = True
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim cc As ContentControl
For Each cc In ThisDocument.ContentControls
'checkboxes have no type attribute to check against, therefore the need of _
error handling on checked-property that is checkbox-only in this usecase
On Error Resume Next
ThisDocument.Bookmarks("text" & cc.Tag).Range.Font.Hidden = Not cc.Checked
ThisDocument.Bookmarks("notext" & cc.Tag).Range.Font.Hidden = cc.Checked
Next
End Sub
I can see no problem here, and the modified and saved file doesn't complain later on. But in the meantime i get the compiling error on closing the ActiveDocument after the import and ActiveDocument.SaveAs2. I get no error without closing the file though, but this is not nice for the work environment, messing up the screen.
Often word crashes, sometimes it just results in a state loss. I also tried encoding as utf-8 and iso 8859-1, disabled screen updating but that does not seem to be the solution as well. What am I missing?
Edit:
What I tried further without success:
disabling syntax checking in the editor
On Error Resume Next
Err.Clear
newDoc.EnableEvents = False (after implementing #Алексей-Р suggestion)
excluding deletion of .VBProject.VBComponents names "ThisDocument"
Also explicitly compiling the modified files code expectedly does not raise any errors. Are there any editor settings I am unaware of?
I try to answer it myself, at least this solved the issue in this case:
I open the file with
Set newDOC = Documents.Add(ThisDocument.FullName, True, wdNewBlankDocument, False)
I can only assume that opening the file in a new blank document and not displaying it might prevent the code executing and therefore having issues being replaced at runtime.
Edit:
it worked at first, then it didn't. Still don't know why. The following now seems to be failproof:
Set newDOC = Documents.Add("", True, wdNewBlankDocument, False)
ThisDocument.Content.Copy
dim rng
Set rng = newDoc.Content
rng.Collapse Direction:=wdCollapseEnd
rng.Paste
'clear clipboard, otherwise an annoying msg popy up everytime because huge content is left there from copying
Dim clscb As New DataObject 'object to use the clipboard
clscb.SetText text:=Empty
clscb.PutInClipboard 'put void into clipboard
This solution opens a new blank document and copypasts the content without having macros in the first place. Afterwards I proceed to rewrite the modules as in the initial snippet from the question
Not sure why it worked for #АлексейР with my provided code though. Thanks for caring anyway!
i have 5 pages in multipage userform.
if the next button enabled, which it can be clicked by user then it should move to next hidden page, i always got an error "Object Required" it drives me crazy.
Private Sub btnGenerate_Click()
iPageNo = MultiPage1.Value + 1
MultiPage1.Pages(iPageNo).Visible = True
MultiPage1.Value = iPageNo
End Sub
that code seems doesnt work for me, any help would be appreciate.
Thanks
Which line is causing the error when you step thru?
Ensure there are enough existing pages. Also, has the name of the MultiPage object changed?
This code below tested working (2 Pages in MultiPage1, Page2 set hidden):
Option Explicit
Private Sub CommandButton1_Click()
Dim iNextPage As Long
With Me.MultiPage1
iNextPage = .Value + 1
If iNextPage < .Pages.Count Then
.Pages(iNextPage).Visible = True
.Value = iNextPage
End If
End With
End Sub
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.
It seems like this guy has had the same problem as me, but the vbModeless doesn't seem to do the trick.
I'm creating a simple add-in, and I want VBA to open a word file, copy the entire content and paste it in the original document.
It works perfectly when executed from the VBA editor or even after the first run where it debugs, but opening a Word instance for the first time and trying to execute the code from the add-in seems to be a problem.
The code is as follows:
Sub insertFigureFrame(control As IRibbonControl)
StandardFrames.StartUpPosition = 0
StandardFrames.Top = Application.Top + (Application.Height - StandardFrames.Height) * 0.5
StandardFrames.Left = Application.Left + (Application.Width - StandardFrames.Width) * 0.5
StandardFrames.Show
End Sub
Sub Standard()
Dim OriginalDocument As String
Dim SaveChanges As Boolean
Dim doc As Document
On Error GoTo err:
Application.DisplayAlerts = wdAlertsNone
Application.ScreenUpdating = False
OriginalDocument = ActiveDocument.Path
Documents.Open MyTemplate
Selection.WholeStory
Selection.Copy
Documents("MyTemplate").Close (SaveChanges = False)
Documents.Open (OriginalDocument)
Selection.PasteAndFormat wdPasteDefault
Exit Sub
err:
Call errHandling
End Sub
The StandardFrames Userform calls the sub Standard.
Any idea what might cause the problem?
EDIT:
I'm using Word 2007 and Windows XP.
Try hidding your userform before you open a document:
Sub Standard()
StandardFrames.Hide
'The rest of your code
End Sub