Макрос слова для подсчета слов в кавычках
Я пишу свои эссе для университета, и мне не разрешают включать слова, используемые в кавычках, к моему общему количеству слов. Поскольку Word не имеет возможности сделать это, я надеялся, что кто-нибудь сможет помочь мне, создав макрос. Я использовал макросы раньше, но у меня очень и очень мало опыта в такой сложной вещи, как эта (если она вообще такая сложная).
У меня уже есть что-то похожее для работы с цитатами в документе, поэтому наличие обеих этих ссылок очень поможет. Я скопирую этот код ниже, чтобы вы могли получить приблизительное представление о том, что мне нужно, за исключением цитат вместо цитат.
Поэтому мне было интересно, сможет ли кто-нибудь создать макрос, который подсчитывает количество слов, используемых в кавычках в документе?
Sub CitationWordCount()
Dim Fld As Field, l As Long, StrTmp As String
For Each Fld In ActiveDocument.Fields
With Fld
If .Type = wdFieldCitation Then
StrTmp = .Result
l = l + UBound(Split(StrTmp, " ")) + UBound(Split(StrTmp, "-")) + 1
StrTmp = .Code.Text
l = l + Len(StrTmp) - Len(Replace(StrTmp, "\n", "\"))
End If
End With
Next
MsgBox "There are " & l & " words in citations in this document.", , "Citation Word Count"
End Sub
1 ответ
Пол Эдштейн (macropod) написал решение этой проблемы несколько месяцев назад на http://www.msofficeforums.com/word-vba/33866-count-words-between-quotation-marks.html
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long
With ActiveDocument
j = .ComputeStatistics(wdStatisticWords)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[“" & Chr(34) & "]*[" & Chr(34) & "”]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
i = i + .ComputeStatistics(wdStatisticWords)
.Collapse wdCollapseEnd
.Find.Execute
Loop
MsgBox "This document contains " & j & " words ," & vbCr & _
"of which " & i & " (" & Format(i * 100 / j, "0.00") & _
"%) are in quotes."
End With
End With
Application.ScreenUpdating = True
End Sub
Это даст вам общее количество слов и общее количество слов в кавычках. Чтобы получить общее количество, просто вычтите слова в кавычках из общего количества слов.