Макрос слова для подсчета слов в кавычках

Я пишу свои эссе для университета, и мне не разрешают включать слова, используемые в кавычках, к моему общему количеству слов. Поскольку 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

Это даст вам общее количество слов и общее количество слов в кавычках. Чтобы получить общее количество, просто вычтите слова в кавычках из общего количества слов.

Другие вопросы по тегам