見出し内にフィールドを挿入する方法

Question

フィールドの前または後ではなく、Wordドキュメントの見出し内にフィールドを挿入しようとしています。これは、Madcap Flareへのインポート用にWordファイルを準備するためのもので、ファイル名をプライベートWordフィールド内で指定することができます。見出しの開始前にフィールドが追加されているため、フィールドがヘッダーの先頭に追加される必要があるため、次のコードは機能しません。これどうやってするの。

Sub prepareDocForImport() 
    Dim headingText As String ' 
     With Selection.Find 
     .ClearFormatting 
     .Wrap = wdFindContinue 
     .Forward = True 
     .Format = True 
     .MatchWildcards = False 
     .Text = "" 
     .Style = ActiveDocument.Styles("Heading 1 ") 
     .Execute 
     While .Found 
      headingText = Selection.Range.Text 
      headingText = Replace(headingText , " ", "_") 
      headingText = LCase(headingText) 
      Selection.Collapse Direction:=wdCollapseStart 
      Set myField = ActiveDocument.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PRIVATE:MADCAP:FILENAME<" & headingText & ">") 
      .Execute 

     Wend 
    End With 
End Sub 

Answer 1

カーソルをヘッダーワードに1文字移動してみてください。

また、ドキュメントの先頭から検索が始まるように行を追加しました。

Sub prepareDocForImport() 

    Dim headingText As String 
    Dim myfield As Field 

    'Moving to beginning of doc in case a different starting point is selected 
    Selection.HomeKey wdStory 

     With Selection.Find 
     .ClearFormatting 
     .Wrap = wdFindContinue 
     .Forward = True 
     .Format = True 
     .MatchWildcards = False 
     .Text = "" 
     .Style = ActiveDocument.Styles("Heading 1 ") 
     .Execute 

     While .Found 

      headingText = Selection.Range.Text 
      headingText = Replace(headingText, " ", "_") 
      headingText = LCase(headingText) 
      Selection.Collapse Direction:=wdCollapseStart 

      'Move seleection one character into the header text 
      Selection.MoveRight Count:=1 

      Set myfield = ActiveDocument.Fields.Add(Range:=Selection.Range, _ 
                Type:=wdFieldEmpty, _ 
                Text:="PRIVATE:MADCAP:FILENAME<" & headingText & ">", _ 
                PreserveFormatting:=True) 
      .Execute 

     Wend 
    End With 
End Sub