I am new to working with VBA and Word 2010.
I have a Word document with some text fields using Content Controls (i.e. rich text control).
I want one of them named (Title) as "testbox" to be a counter of how many times the document has been printed.
I have some code from Excel that works. Is it possible to use this in MS Word? How do I communicate with the Content Control instead of a cell in Excel?
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
ActiveSheet.PrintOut
Range("A1").Value = Range("A1").Value + 1
Application.EnableEvents = True
End Sub
The basic approach of the code you show should work in Word, you just need to look up the appropriate names of the objects, methods and properties. Document_BeforePrint, for example, and ActiveDocument.Print.
Word doesn't have an EnableEvents property so you need to create your own method or methods for turning off the events you define at the Application level. How those methods should look and what they require is part of the discussion about how to use Application level events in Office - part of the VBA Language Reference (https://msdn.microsoft.com/en-us/library/office/ff821218.aspx).
A ContentControl can be picked up by its Title using the Document.SelectContentControlsByTitle method. This returns an array of content controls having the same Title. If you have only the one, then something like this:
Dim cc As Word.ContentControl
Dim ccs as Word.ContentControls
Set ccs = ActiveDocument.SelectContentControlsByTitle("testbox")
Set cc = ccs(1)
cc.Range.Text = Cstr(CInt(cc.Range.Text) + 1)
Related
I am trying to create a form that requires text boxes to be disabled until a checkbox is ticked. Previously I have been able to use activeX and Legacy tools in the document but after a software upgrade to a 3rd party application the manufacture no longer supports these. I am therefore having to re-learn how to use content control boxes and their VBA controls.
This is my attempt based at varying google responses. "Lowers" is the checkbox. "Long3""Long4" "Lat2""Vert2" are the textboxes I am trying to control.
I had managed to disable the textboxes but this now seems to have been lost.
Any suggestions would be greatly appreciated.
Private Lowers_onChange()
Dim oCC_Lowers As ContentControl
Set oCC_Lowers = ActiveDocument.SelectContentControlsByTag("Lowers").Item(1)
Dim oCC_Long3 As ContentControl
Set oCC_Long3 = ActiveDocument.SelectContentControlsByTag("Long3").Item(2)
Dim oCC_Long4 As ContentControl
Set oCC_Long4 = ActiveDocument.SelectContentControlsByTag("Long4").Item(3)
Dim oCC_Lat2 As ContentControl
Set oCC_Lat2 = ActiveDocument.SelectContentControlsByTag("Lat2").Item(4)
Dim oCC_Vert2 As ContentControl
Set oCC_Vert2 = ActiveDocument.SelectContentControlsByTag("Vert2").Item(5)
If oCC_Lowers.LockcontentControl = True Then
oCC_Long3.LockContents = False
oCC_Long4.LockContents = False
oCC_Lat2.LockContents = False
oCC_Vert2.LockContents = False
Else
oCC_Long3.LockContents = True
oCC_Long4.LockContents = True
oCC_Lat2.LockContents = True
oCC_Vert2.LockContents = True
End If
End Sub
Firstly a link to a good resource on working with Content Controls: Greg Maxey's Word Content Controls page
As your code is an event handler responding to a built-in event, it needs to be in the ThisDocument module. As there isn't a Change event you need to use the OnExit event. You can find this by navigating to the ThisDocument module in the VBE and selecting Document in the left hand drop-down. In the right hand drop-down select ContentControlOnExit. An empty event handler is then created with the correct syntax.
You will note that this event handler will fire for every content control in the document, so you need to test the value of ContentControl.Tag to see if it is the one that you need to work with.
Once you have verified that you have the correct content control you can then use the value of its Checked property to set the value of the LockContents property of each of the other content controls. Your completed code should then look like this:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If ContentControl.Tag = "Lowers" Then
Dim oCC_Long3 As ContentControl
Set oCC_Long3 = ActiveDocument.SelectContentControlsByTag("Long3").Item(1)
oCC_Long3.LockContents = Not ContentControl.Checked
Dim oCC_Long4 As ContentControl
Set oCC_Long4 = ActiveDocument.SelectContentControlsByTag("Long4").Item(1)
oCC_Long4.LockContents = Not ContentControl.Checked
Dim oCC_Lat2 As ContentControl
Set oCC_Lat2 = ActiveDocument.SelectContentControlsByTag("Lat2").Item(1)
oCC_Lat2.LockContents = Not ContentControl.Checked
Dim oCC_Vert2 As ContentControl
Set oCC_Vert2 = ActiveDocument.SelectContentControlsByTag("Vert2").Item(1)
oCC_Vert2.LockContents = Not ContentControl.Checked
End If
End Sub
i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub
I have the following code in VBA (MS Word), that is meant to run after I click in a button, named cmdFormPreencher inserted in my Document:
Private Sub cmdFormPreencher_Click()
'
If ActiveDocument.FormsDesign = False Then
ActiveDocument.ToggleFormsDesign
End If
'
ThisDocument.cmdFormPreencher.Select
ThisDocument.cmdFormPreencher.Delete
ActiveDocument.ToggleFormsDesign
'
UserForm2.Show
End Sub
The purpose of the code above is to delete that button inserted in my document.
But when I run the code only the button is selected. When I tried to figure out what is happening by debugging, it showed me the code runs until ActiveDocument.ToggleFormsDesign and not running the code remaining
Is this a bug of VBA, or am I doing something wrong? If so, how can I get around this problem?
Thanks!
Note: The ActiveX button is not in Header and Footer. The Text Wrap is set to In Front of Text
Edit:
When I try to run a macro, activating FormDesign, Selecting the ActiveX button and then deleting, I get this code:
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveDocument.ToggleFormsDesign
ActiveDocument.Shapes("Control 52").Select
Selection.ShapeRange.Delete
ActiveDocument.ToggleFormsDesign
End Sub
But when I run this code nothing happens...
This is by design. When an Office application is in Design Mode code should not run on an ActiveX object that's part of the document.
I take it this is an ActiveX button and in that case, it's a member of the InlineShapes or Shapes collection - Word handles it like a graphic object. It should be enough to delete the graphical representation, which you can do by changing it to display as an icon instead of a button.
For example, for an InlineShape:
Sub DeleteActiveX()
Dim ils As word.InlineShape
Set ils = ActiveDocument.InlineShapes(1)
ils.OLEFormat.DisplayAsIcon = True
ils.Delete
End Sub
You just have to figure out how to identify the InlineShape or Shape. You could bookmark an InlineShape; a Shape has a Name property.
EDIT: Since according to subsequent information provided in Comments you have a Shape object, rather than an InlineShape, the following approach should work:
Dim shp As word.Shape
Set shp = ActiveDocument.Shapes("Shape Name") 'Index value can also be used
shp.Delete
Note that Word will automatically assign something to the Shape.Name property, but in the case of ActiveX controls these names can change for apparently no reason. So if you identify a control using its name instead of the index value it's much better to assign a name yourself, which Word will not change "on a whim".
Activate Design Mode.
Click on the control to select it
Go to the VB Editor window
Ctrl+G to put the focus in the "Immediate Window"
Type the following (substituting the name you want), then press Enter to execute:
Selection.ShapeRange(1).Name = "Name to assign"
Use this Name in the code above
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.
I have been creating an acronym finding macro that will sit on a custom toolbar in word. When run it searches the document for acronyms and places them in a table. I want to include some user forms so that as the macro finds an acronym the user can select the predefined definition (got from an excel document) or enter their own new one (I know multiple acronyms meanings is frowned upon but it happens).
Anyway I am stuck. I have created a user form with three buttons. A text input and a label. Now I have managed to set the label text with the acronym that was found however I can't seem to get the buttons to change a variable, userChoice, and if applicable save the newly entered definition.
below is the test macro i have been trying this out on
Sub userFormTest()
Dim objExcel As Object
Dim objWbk As Object
Dim rngSearch As Object
Dim rngFound As Object
Dim targetCellValue As String
Dim userChoice As Integer
Set objDoc = ActiveDocument
Set objExcel = CreateObject("Excel.Application")
Set objWbk = objExcel.Workbooks.Open("C:\Users\Dave\Documents\Test_Definitions.xlsx")
objExcel.Visible = True
objWbk.Activate
With objWbk.Sheets("Sheet1")
Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))
Set rngFound = rngSearch.Find(What:="AA", After:=.Range("A1"), LookAt:=1)
If rngFound Is Nothing Then
UserForm1.Label1.Caption = "Acronym: AA" & vbCr & _
"Definition: Not found, please enter a definition below" & vbCr & _
" or choose to ignore this acronym"
UserForm1.Show
'an if statement here so that if the add button was pressed it adds to doc etc
Else
targetCellValue = .Cells(rngFound.Row, 2).Value
UserForm2.Label1.Caption = "Acronym: AA" & vbCr & _
"Definition: " & targetCellValue
UserForm2.Show
'an if statement here so that if the add button was pressed it adds to doc etc
End If
End With
objWbk.Close Saved = True
Set rngFound = Nothing
Set rngSearch = Nothing
Set objWbk = Nothing
objExcel.Visible = True
Set objExcel = Nothing
Set objDoc = Nothing
End Sub
I do realise that this could be done in the button_click() subs however I already have all the documents open etc in the other macro. Or is it possible to link to those already open documents? To be honest either way I would prefer to return to the main macro and just use the form to the user input.
I do realise that this could be done in the button_click() subs. However I already have all the documents open etc in the other macro. Or is it possible to link to those already open documents?
You can definitely link between button_click() subs and your main macro to modify the value of userChoice.
Answer:
What you need is some userform element (like a textbox) that can hold your value so you can refer back to it in your main macro. It looks like you already have this element (based upon your caption "Not found, please enter a definition below"). Let's say that element is a TextBox called Definition. Then let's say you want to return to the main macro after people push an "Add" button, as it appears you do (based upon your comment "so that if the add button was pressed it adds to doc").
In each of both Userform1 and Userform2, you would want something like this:
Private Sub AddButton_Click()
Userform1/Userform2.Hide
End Sub
That would return you to your main macro, where you could follow up with:
If Userform1/Userform2.Definition.Value = Whatever Then
'if the add button was pressed it adds to doc etc
End If
right where your existing comments are. Note that you could set userChoice = Userform1.Definition.Value here, but you don't need to because Userform1.Definition.Value already contains the information you need to track.
Additional material:
Rather than using the default instance of your Userform1 and Userform2 by using .Show on them immediately without assigning new instances of them to variables, may I suggest creating Userform variables to contain New instances of them like this:
Dim UnknownDefinition As Userform1
Set UnknownDefinition = New Userform1
UnknownDefinition.Show
Or if you want to get really optimal, you could follow more of the approach recommended here on how to make a properly instanced, abstracted userform:
Rubberduck VBA: How to create a properly instanced, abstracted userform
And now with bonus quotes from the post's author, #Mathieu Guindon:
make Definition a proper property, with the Property Let mutator changing the label value on top of changing its private backing field's value; avoid accessing form controls outside the form, treat them as private even if VBA makes them public.
Calling code wants data, not controls. You can extract properties/data, but not controls, into a dedicated model class.