MS Word 문서를 VBA 스타일로 구문 분석하는 방법

Question

MSWord 문서를 살펴보고 스타일이있는 모든 단락을 꺼내고 "질문"을 한 다음 문서 끝 부분에서 다시 인쇄하려고합니다. 모든 제안은 도움이 될 것입니다. 여기에 제가 가지고있는 것이 있습니다. (모든 단계가 VBA 포맷팅에 문제가 있다고 생각합니다.)

Sub PullQuestions() 
    ' 
    ' PullQuestions Macro 
    ' 
    ' 
    Dim curPar As Paragraph 

    ' numLists = ActiveDocument.ListParagraphs.Count 

    ' reprints each question on a new line at end of document' 
    For Each curPar In ActiveDocument.Paragraphs 
     If curPar.Selection.Style = "Question" Then 
      Selection.TypeText (curPar & vbCr) 
     End If 
    End Sub 

Answer 1

검색 기능이 아마도 당신에게 더 효율적이라고 생각합니다. 다음 코드는 문서를 검색하여 값을 배열에 넣은 다음 문서 끝에 넣습니다. 또한 원고를 반영하도록 단락 스타일을 설정합니다. 문서 끝에 출력물에 적용된 스타일을 사용하여 계속 실행하면 불쾌한 결과를 얻는다는 사실을 알고 있어야합니다.

나는 그것을 아주 잘 설명했지만 이해가되지 않으면 알려주지.

Sub SearchStyles() 
    Dim iCount As Integer, iArrayCount As Integer, bFound As Boolean 

    'We'll store our result in an array so set this up (assume 50 entries) 
    ReDim sArray(1 To iArrayCount) As String 
    iArrayCount = 50 

    'State your Style type 
    sMyStyle = "Heading 1" 

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

    'Set your search parameters and look for the first instance 
    With Selection.Find 
     .ClearFormatting 
     .Text = "" 
     .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 
     .Style = sMyStyle 
     .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 

     'If we have a result then add the text to the array 
     If Selection.Find.Found Then 
      bFound = True 

      'We do a check on the array and resize if necessary (more efficient than resizing every loop 
      If ii Mod iArrayCount = 0 Then ReDim Preserve sArray(1 To UBound(sArray) + iArrayCount) 
      sArray(iCount) = Selection.Text 

      'Reset the find parameters 
      Selection.Find.Execute 
     End If 
    Loop 

    'Finalise the array to the actual size 
    ReDim Preserve sArray(1 To iCount) 

    If bFound Then 
     'Output to the end of the document 
     ActiveDocument.Bookmarks("\EndOfDoc").Range.Select 
     Selection.TypeParagraph 
     For ii = LBound(sArray) To UBound(sArray) 
      Selection.Text = sArray(ii) 
      Selection.Range.Style = sMyStyle 
      Selection.MoveRight wdCharacter, 1 
      If ii < UBound(sArray) Then Selection.TypeParagraph 
     Next ii 
    End If 
End Sub