Hi I've written a very simple bit of VBA code... Now I'm no VBA expert by any means, but the code is saved in a .dotm file and while in the template file everything runs perfectly.
The file is suppose to autofill the content control fields on exit that are located in the header of the document, but when I run the code for a particular CC field titled Client_Name the corresponding CC field, Head_Client_Name is supposed to set the text to match and to capitalise the text with wdUpperCase. This all happens in the template macro enabled file
However once the file is selected to create a new document file, the CC doesn't update on exit. What am I doing wrong or why is the file doing this?
Just as a side, the original template document was saved as a MS Word 97 file which was then saved to .dotm file during development of the VBA code. I don't know if this would contribute to the issues.
Option Explicit
Private runOnce As Boolean
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim i As ContentControl
Dim n As Integer
n = 0
Set i = ThisDocument.SelectContentControlsByTag("Rev Table").Item(1)
Select Case ContentControl.Title
Case "Client Logo"
If runOnce = True Then
runOnce = False
Exit Sub
Else
Call HeadLogoUpdate
runOnce = True
End If
Case "Project_num"
'MsgBox "The user selected a file, specifically: " & ContentControl.Range.Text
For Each ContentControl In ThisDocument.SelectContentControlsByTag("Doc_num")
ContentControl.LockContents = False
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Project_num").Item(1).Range.Text
ContentControl.LockContents = True
Next ContentControl
For Each ContentControl In ThisDocument.SelectContentControlsByTitle("Head_Project_num")
ContentControl.LockContents = False
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Project_num").Item(1).Range.Text
ContentControl.LockContents = True
Next ContentControl
Case "Client_Name"
For Each ContentControl In ThisDocument.SelectContentControlsByTitle("Head_Client_Name")
ContentControl.LockContents = False
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Client_Name").Item(1).Range.Text
ContentControl.Range.Case = wdUpperCase
ContentControl.LockContents = True
Next ContentControl
Case "Project_Name"
For Each ContentControl In ThisDocument.SelectContentControlsByTitle("Head_Project_Name")
ContentControl.LockContents = False
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Project_Name").Item(1).Range.Text
ContentControl.Range.Case = wdUpperCase
ContentControl.LockContents = True
Next ContentControl
Case "Rev. No."
For Each ContentControl In ThisDocument.SelectContentControlsByTitle("Head_Rev")
ContentControl.LockContents = False
If i.RepeatingSectionItems.Count > 1 Then
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Rev. No.").Item(i.RepeatingSectionItems.Count).Range.Text
Else
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Rev. No.").Item(1).Range.Text
End If
ContentControl.LockContents = True
Next ContentControl
Case "Date"
'MsgBox i.RepeatingSectionItems.Count
For Each ContentControl In ThisDocument.SelectContentControlsByTitle("Head_Date")
ContentControl.LockContents = False
If i.RepeatingSectionItems.Count > 1 Then
ContentControl.Range.Text = ThisDocument.SelectContentControlsByTitle("Date").Item(i.RepeatingSectionItems.Count - 1).Range.Text
Else
ContentControl.Range.Text = Format(ThisDocument.SelectContentControlsByTitle("Date").Item(1).Range.Text, "yyyy/MM/dd")
End If
ContentControl.LockContents = True
Next ContentControl
Case Else
'The user exited some other content control that we don't care about.
End Select
ActiveWindow.ActivePane.View.Type = wdPrintView
lbl_Exit:
Exit Sub
End Sub
Sub HeadLogoUpdate()
'
Dim cc As ContentControl
Dim CLheight As Long, CLwidth As Long, HCLheight As Long, ScaleHeight As Long
Dim n As Integer
n = 0 'Integer to count the number of times for each loops
'This part sets the scale for the logo in the header
HCLheight = 0.9 'This is the height of the SGS Bateman logo in the header in cm
HCLheight = HCLheight / Application.PointsToCentimeters(1)
CLheight = ThisDocument.SelectContentControlsByTitle("Client Logo").Item(1).Range.InlineShapes(1).Height
CLwidth = ThisDocument.SelectContentControlsByTitle("Client Logo").Item(1).Range.InlineShapes(1).Width
ScaleHeight = HCLheight * 100 / CLheight
CLheight = CLheight / Application.PointsToCentimeters(1)
Dim CLheightDisplay As Long
CLheightDisplay = Format(CLheight, "#.00")
CLwidth = CLwidth / Application.PointsToCentimeters(1)
Dim CLwidthDisplay As Long
CLwidthDisplay = Format(CLwidth, "#.00")
'Select and copy the logo in the first page for pasting in the header
ActiveDocument.SelectContentControlsByTitle("Client Logo")(1).Range.Select
Selection.Copy
'Run through the document and paste the logo in the content controls the header and scale to fit.
For Each cc In ActiveDocument.SelectContentControlsByTitle("Head Client Logo")
n = n + 1
'Activate the header section
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'Select the content control
ActiveDocument.SelectContentControlsByTitle("Head Client Logo").Item(n).Range.Select
Selection.Paste
ThisDocument.SelectContentControlsByTitle("Head Client Logo").Item(n).Range.InlineShapes(1).LockAspectRatio = msoTrue
ThisDocument.SelectContentControlsByTitle("Head Client Logo").Item(n).Range.InlineShapes(1).ScaleHeight = ScaleHeight
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 'Activate the page view again/main document
Next cc
End Sub
The problem is due to your use of 'ThisDocument' - you should use 'ActiveDocument'. Since the macro is in your template, 'ThisDocument' refers to the template, not to the document created from it - which is the active document.