[英]How to parse MS Word document by style with VBA
我正在嘗試瀏覽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
我認為您會發現搜索功能可能對您更有效。 以下代碼將搜索文檔,並將值放入數組,然后將其放在文檔末尾。 它還將設置段落樣式以反映原始樣式。 請注意,如果繼續使用文檔末尾應用到輸出的樣式來運行該輸出,則會得到討厭的輸出。
我的評論還不錯,但是如果沒有意義,請告訴我。
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.