VBAを使用するヘッダーの2つのフォント

Question

My Word文書には、約260のセクションと、セクションごとに一意のヘッダーがあります。各ヘッダーは、左側が1つのテキスト/フォントで、右側が別のテキスト/フォントである必要があります。私はさまざまな言語で作っている一連のバイリンガルな本のためのものです。ここでは、私がしようとしたコードですが、それはヘッダーの後半のフォントを変更していません。最初の4行のコードはヘッダーテキストを正常に変更しますが、コードの次の部分はフォントを変更しません。 FYIとして、 "Korean Chapter 1"と言う部分は韓国語で韓国語フォントを使用します。

Dim text1 As String 
Dim text2 As String 

With ActiveDocument.Sections(1) 
'Changing the text 
text1 = "English Chapter 1" 
text2 = "Korean Chapter 1" 
.Headers(wdHeaderFooterPrimary).Range.Text = text1 & vbTab & text2 
'Changing the font 
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
Selection.MoveRight Unit:=wdCharacter, Count:=Len(text1) 
Selection.EndKey Unit:=wdStory, Extend:=wdExtend 
Selection.Font.Name = "Batang" 
End With 

With ActiveDocument.Sections(2) 
'Changing the text 
text1 = "English Chapter 2" 
text2 = "Korean Chapter 2" 
.Headers(wdHeaderFooterPrimary).Range.Text = text1 & vbTab & text2 
'Changing the font 
SeekView = wdSeekCurrentPageHeader 
Selection.MoveRight Unit:=wdCharacter, Count:=Len(text1) 
Selection.EndKey Unit:=wdStory, Extend:=wdExtend 
Selection.Font.Name = "Batang" 
End With 

With ActiveDocument.Sections(3)... continuing until the last section 

Answer 1

セレクタをヘッダーの最後まで拡張すると、段落記号が含まれます。フォントを設定すると、段落全体のフォントが変更されます。

Wordでコーディングする場合は、特にヘッダーとフッターで作業する場合は、できるだけSelectionオブジェクトを使用しないでください。以下のコードはあなたのために働くはずです。

Sub SetHeaderText() 
    Dim text1 As String 
    Dim text2 As String 
    Dim rng As Range 

    With ActiveDocument.Sections(1) 
     'Changing the text 
     text1 = "English Chapter 1" 
     text2 = "Korean Chapter 1" 
     Set rng = .Headers(wdHeaderFooterPrimary).Range 
     rng.Text = text1 & vbTab & text2 
     rng.MoveStart Unit:=wdCharacter, Count:=Len(text1) + 1 
     rng.Font.Name = "Batang" 
    End With 
End Sub 

あなたがヘッダに追加されたテキストは、実際には章番号であれば、あなたのコードを簡素化し、本当にこのような何かを行うことによって、物事をスピードアップすることができます：

Sub SetHeaderText() 
    Dim text1 As String 
    Dim text2 As String 
    Dim rng As Range 
    Dim sec As Section 
    Dim num As Integer 

    num = 1 
    For Each sec In ActiveDocument.Sections 
     'Changing the text 
     text1 = "English Chapter " & num 
     text2 = "Korean Chapter " & num 
     Set rng = .Headers(wdHeaderFooterPrimary).Range 
     rng.Text = text1 & vbTab & text2 
     rng.MoveStart Unit:=wdCharacter, Count:=Len(text1) + 1 
     rng.Font.Name = "AR Julian" 
     num = num + 1 
    Next 
End Sub