2012-11-20 11 views
8

特定のテキスト(マークアップコードで示される)を検索し、テキストを切り取り、新しい脚注に挿入してマークアップコードを削除するMS Wordマクロを作成しました脚注今度は、マクロ内にマークアップコードが見つからなくなるまで、マクロを繰り返すようにします。
はここで、検索結果が見つからなくなるまでMicrosoft Word VBAを繰り返します。

Sub SearchFN() 

'find a footnote 
Selection.Find.ClearFormatting 
With Selection.Find 
    .Text = "&&FB:*&&FE" 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindContinue 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchKashida = False 
    .MatchDiacritics = False 
    .MatchAlefHamza = False 
    .MatchControl = False 
    .MatchByte = False 
    .MatchAllWordForms = False 
    .MatchSoundsLike = False 
    .MatchFuzzy = False 
    .MatchWildcards = True 
End With 
Selection.Find.Execute 

'cut the footnote from the text 
Selection.Cut 

'create a proper Word footnote 
With Selection 
    With .FootnoteOptions 
     .Location = wdBottomOfPage 
     .NumberingRule = wdRestartContinuous 
     .StartingNumber = 1 
     .NumberStyle = wdNoteNumberStyleArabic 
    End With 
    .Footnotes.Add Range:=Selection.Range, Reference:="" 
End With 

'now paste the text into the footnote 
Selection.Paste 

'go to the beginning of the newly created footnote 
'and find/delete the code for the start of the note (&&FB:) 
    Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 
With Selection.Find 
    .Text = "&&FB:" 
    .Replacement.Text = "" 
    .Forward = False 
    .Wrap = wdFindContinue 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchKashida = False 
    .MatchDiacritics = False 
    .MatchAlefHamza = False 
    .MatchControl = False 
    .MatchByte = False 
    .MatchAllWordForms = False 
    .MatchSoundsLike = False 
    .MatchFuzzy = False 
    .MatchWildcards = True 
End With 
Selection.Find.Execute 
With Selection 
    If .Find.Forward = True Then 
     .Collapse Direction:=wdCollapseStart 
    Else 
     .Collapse Direction:=wdCollapseEnd 
    End If 
    .Find.Execute Replace:=wdReplaceOne 
    If .Find.Forward = True Then 
     .Collapse Direction:=wdCollapseEnd 
    Else 
     .Collapse Direction:=wdCollapseStart 
    End If 
    .Find.Execute 
End With 

'do same for ending code (&&FE) 
With Selection.Find 
    .Text = "&&FE" 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindContinue 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchKashida = False 
    .MatchDiacritics = False 
    .MatchAlefHamza = False 
    .MatchControl = False 
    .MatchByte = False 
    .MatchAllWordForms = False 
    .MatchSoundsLike = False 
    .MatchFuzzy = False 
    .MatchWildcards = True 
End With 
Selection.Find.Execute 
With Selection 
    If .Find.Forward = True Then 
     .Collapse Direction:=wdCollapseStart 
    Else 
     .Collapse Direction:=wdCollapseEnd 
    End If 
    .Find.Execute Replace:=wdReplaceOne 
    If .Find.Forward = True Then 
     .Collapse Direction:=wdCollapseEnd 
    Else 
     .Collapse Direction:=wdCollapseStart 
    End If 
    .Find.Execute 
End With 

Selection.HomeKey Unit:=wdStory 
'now repeat--but how??  

End Sub 

答えて

11

良い質問以下のマクロこの一つだことができますSelection.Find.Found結果を用いて文書全体をループ。

あなたがしているのは検索を開始し、結果が真であるときにループに入るのはSelection.Find.Foundです。これらを通過すると、完了です。次のコードはあなたのためにうまくいくはずです。

Sub SearchFN() 
    Dim iCount As Integer 

    'Always start at the top of the document 
    Selection.HomeKey Unit:=wdStory 

    'find a footnote to kick it off 
    With Selection.Find 
     .ClearFormatting 
     .Text = "&&FB:*&&FE" 
     .Replacement.Text = "" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = False 
     .MatchCase = False 
     .MatchWholeWord = False 
     .MatchKashida = False 
     .MatchDiacritics = False 
     .MatchAlefHamza = False 
     .MatchControl = False 
     .MatchByte = False 
     .MatchAllWordForms = False 
     .MatchSoundsLike = False 
     .MatchFuzzy = False 
     .MatchWildcards = True 
     .Execute 
    End With 

    'If we find one then we can set off a loop to keep checking 
    'I always put a counter in to avoid endless loops for one reason or another 
    Do While Selection.Find.Found = True And iCount < 1000 
     iCount = iCount + 1 

     'Jump back to the start of the document. Since you remove the 
     'footnote place holder this won't pick up old results 
     Selection.HomeKey Unit:=wdStory 
     Selection.Find.Execute 

     'On the last loop you'll not find a result so check here 
     If Selection.Find.Found Then 

      ''================================== 
      '' Do your footnote magic here 
      ''================================== 

      'Reset the find parameters 
      With Selection.Find 
       .ClearFormatting 
       .Text = "&&FB:*&&FE" 
       .Replacement.Text = "" 
       .Forward = True 
       .Wrap = wdFindContinue 
       .Format = False 
       .MatchCase = False 
       .MatchWholeWord = False 
       .MatchKashida = False 
       .MatchDiacritics = False 
       .MatchAlefHamza = False 
       .MatchControl = False 
       .MatchByte = False 
       .MatchAllWordForms = False 
       .MatchSoundsLike = False 
       .MatchFuzzy = False 
       .MatchWildcards = True 
      End With 
     End If 
    Loop 
End Sub 
関連する問題