嗨，我寫了一段非常簡單的 VBA 代碼...現在我無論如何都不是 VBA 專家，但是代碼保存在 .dotm 檔案中，而在模板檔案中，一切運行良好。
該檔案假設在退出時自動填充位于檔案標題中的內容控制欄位，但是當我為標題Client_Name為相應 CC 欄位的特定 CC 欄位運行代碼時，Head_Client_Name應該將文本設定為匹配并大寫帶有 的文本wdUpperCase。這一切都發生在模板宏啟用檔案中
但是，一旦選擇該檔案來創建新的檔案檔案，CC 就不會在退出時更新。我在做什么錯或為什么檔案這樣做？
順便說一句，原始模板檔案保存為 MS Word 97 檔案，然后在開發 VBA 代碼期間保存為 .dotm 檔案。我不知道這是否會導致問題。
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
uj5u.com熱心網友回復：
問題是由于您使用了“ThisDocument”——您應該使用“ActiveDocument”。由于宏在您的模板中，“ThisDocument”指的是模板，而不是從它創建的檔案 - 這是活動檔案。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/494343.html
上一篇：轉置由空白行分隔的范圍