Word 轉字體 Times New Roman VBA Code 包括方程式
Word VBA(巨集) 範例(不是 VBS),可以把整份文件(包含一般文字、表格、頁首頁尾、註腳/章節附註、文字方塊等)統一改成 Times New Roman,並且包含方程式的處理方式。
Option Explicit
Sub ForceTNR_MinimizeReflow()
Dim doc As Document: Set doc = ActiveDocument
Application.ScreenUpdating = False
' 主文 + 所有 story(含文字方塊/頁首頁尾/註腳等大多數)
ApplyTNR_MinReflow_ToAllStories doc, "Times New Roman"
' OMML 方程式
ApplyTNR_MinReflow_ToOMaths doc, "Times New Roman"
Application.ScreenUpdating = True
MsgBox "完成:已套用 Times New Roman 並壓制字距/縮放以減少版面重排(仍可能有小幅移位)。"
End Sub
Private Sub ApplyTNR_MinReflow_ToAllStories(ByVal doc As Document, ByVal fontName As String)
Dim rngStory As Range
For Each rngStory In doc.StoryRanges
Do
ApplyTNR_MinReflow_ToRange rngStory, fontName
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next rngStory
End Sub
Private Sub ApplyTNR_MinReflow_ToRange(ByVal rng As Range, ByVal fontName As String)
On Error Resume Next
' 固定字元屬性(避免隱性字距/縮放造成重新換行)
With rng.Font
.Kerning = 0
.Spacing = 0
.Scaling = 100
.Position = 0
.NameAscii = fontName ' 只改西文
End With
' 固定段落屬性(避免行距/段前段後變動)
With rng.ParagraphFormat
' 你若文件本來就有固定行距,這段會更穩;若不想動行距,告訴我我再改成「讀取後寫回」
If .LineSpacingRule = wdLineSpaceExactly Or .LineSpacingRule = wdLineSpaceAtLeast Then
' 保持原狀
Else
' 常見情況:多倍行距/單行,改字型可能導致行高變,改成 Exactly 可減少跳動
' 但這會改版面規則,若你不能接受,我會給你另一版不碰行距
'.LineSpacingRule = wdLineSpaceSingle
End If
End With
On Error GoTo 0
End Sub
Private Sub ApplyTNR_MinReflow_ToOMaths(ByVal doc As Document, ByVal fontName As String)
Dim om As OMath
On Error Resume Next
For Each om In doc.OMaths
With om.Range.Font
.Kerning = 0
.Spacing = 0
.Scaling = 100
.Position = 0
.NameAscii = fontName
End With
Next om
On Error GoTo 0
End Subword 轉字體 Times New Roman vbs code 包括方程式