Word VBA to control formatting and content of table cells in heading - vba

Question

Frequently, I have to change all headings of a word-document depending on a the content of a customproperty. For example, if the document prorperty 'Status' equeals to anything but final, all headings must contain 'DRAFT' written in bold characters on a red-background. If the document is 'final', DRAFT must not appear and the background must be 'none'.
Except for the first section, our headings contain a table consisting of one row and two cells. Cell 1 must be flipped depending on the 'Status', Cell 2 must remain unchanged.
Is there any known solution (VBA or cell-specific 'IF-THEN-ELSE Statements) to change the content of cell 1 throughout the whole document depending on the Status document property? Currently, I do have to scroll through all sections and change the header manually.

Answer 1

You can do this using a field and a macro. The field will create the values, and the macro will update them to account for changes.
Let's say that you're using the document property status as you've described. If the value is "DRAFT" the text in the table will be "This is a draft" and if it is anything else the text will be "This is not a draft". Word can be squirrely about these properties, so the first thing I would do is a test. Set your property to DRAFT and then create a field to ensure that Word is reading it.
Anywhere in your document type:
[Ctrl+F9] DOCPROPERTY Status
This will result in text that looks like
{DOCPROPERTY Status}
but be aware that you have to use Ctrl+F9 to get the special field brackets.
Now toggle the field code (select, right-click and choose Toggle Field Codes). If it becomes text that says DRAFT you are ready to go. If not, you may not be setting the property the way that Word wants you to. The way I do this is by going to Advanced Properties, clicking the Custom tab, finding Status in the list, adding the value, and clicking Add so that it appears below. There may be other ways, but that works.
Once you've had success with that field code, create a new one in your table that looks like this (remember that all brackets are created with Ctrl+F9):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1 "This is a draft" "This is not a draft" }
The If statement compares the value of the compare statement to 1, and the two quoted strings after reflect what will appear if the If statement evaluates to true, and what will appear if it evaluates to false. Toggle the field codes to see what you get.
Then, you can create a little macro that will update them all for you, so you don't have to manually update each one. Something like this should work:
Public Sub UpdateAllFields()
Dim objDoc as Document
Dim objSect As Section
Dim objHeader As HeaderFooter, objFooter As HeaderFooter
Set objDoc = ActiveDocument
objDoc.Fields.Update
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
objHeader.Range.Fields.Update
Next objHeader
For Each objFooter In objSect.Footers
objFooter.Range.Fields.Update
Next objFooter
Next objSect
End Sub
I misread and didn't realize the color change applied to these tables, so adding something about that.
The font color can be changed using the field. Change the field above so that it looks like this (remember about Ctrl+F9) (I'm adding some line breaks for readability. Do not include these in your field. Put it all on one line):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1
{ QUOTE "This is a draft" \*Charformat }
{ QUOTE "This is not a draft" \*Charformat } }
Then select each of the quote fields in turn and apply whatever font formatting you need. You can also apply highlighting in this way; I don't think this will be sufficient for your requirement to shade the whole cell but you might try it out and see if you can avoid additional steps.
If you definitely need to shade the whole cell, than you'll need another macro. Something like this should do it:
Sub ChangeCol()
Dim objDoc As Document
Dim objTable As Table, objCell As Cell
Dim objFld As Field
Set objDoc = ActiveDocument
For Each objFld In objDoc.Fields
If objFld.result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
If objDoc.CustomDocumentProperties("Status").Value = "DRAFT" Then
objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else: objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
End If
Next objFld
End Sub
Just run that along with the UpdateFields macro to keep them in sync (or write a third macro that triggers both of them so you don't forget).

Answer 2

Please accept my acknowledges once more. Hereafter, the macros I make use of for my purpose:
Private Sub colorizeTableCells(ByVal oFields As fields, sStatus As String)
Dim objFld As field
Dim bgColor As WdColor
oFields.Update
For Each objFld In oFields
If objFld.Result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
bgColor = wdColorAutomatic
If sStatus = "DRAFT" Then
bgColor = wdColorRed
End If
objFld.Result.Cells(1).Shading.BackgroundPatternColor = bgColor
End If
Next objFld
End Sub
Sub processHeaderAndFooterFields()
Dim objDoc As Document
Dim objSect As Section
Dim objHeader As HeaderFooter
Dim objFooter As HeaderFooter
Dim sStatus As String
Set objDoc = ActiveDocument
sStatus = objDoc.CustomDocumentProperties("Status").Value
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
colorizeTableCells oFields:=objHeader.range.fields, sStatus:=sStatus
Next objHeader
For Each objFooter In objSect.Footers
colorizeTableCells oFields:=objFooter.range.fields, sStatus:=sStatus
Next objFooter
Next objSect
End Sub