Home > Software design >  Vba throws error in .docx but not in .dotm file with content control
Vba throws error in .docx but not in .dotm file with content control

Time:06-21

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

CodePudding user response:

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.

  • Related