Campos de recuento de palabras

adminagosto 14, 2024

0 0 2 minutos de lectura

VBA

Módulo estándar

Este código se ejecuta en Word y cuenta todos los campos o solo los campos de una propiedad particular en ActiveDocument o cualquier documento especificado.

Option Explicit  'require variable declaration
Option Compare Text  'case insensitive

'*************** Code Start *****************************************************
' module name: mod_Word_CountField_s4p
'-------------------------------------------------------------------------------
' Purpose  : count the number of fields
'              that refer to a specific property
'              or total number of fields in a Word Document
' Author   : crystal (strive4peace)
' Code List: 
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark changes. Use at your own risk.
'-------------------------------------------------------------------------------

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           Word_CountField
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function Word_CountField( _ 
   poWordDocument As Word.Document _ 
   ,Optional ByVal psPropertyName As String =  "" _ 
   ) As Long 
'240119 strive4peace
'return number of fields that refer to a specific property
'or total number of fields in poWordDocument

   On Error GoTo Proc_Err 
   
   'initialize return value
   Word_CountField = 0 
   
   If poWordDocument Is Nothing Then Exit Function 
   
   'early binding
   Dim oField As Word.Field 
   Dim oRangeStory As Word.Range 
   
   If psPropertyName =  "" Then 
      'number of fields in the doc
      'loop through story ranges
      For Each oRangeStory In poWordDocument.StoryRanges 
         Word_CountField = Word_CountField _ 
            + oRangeStory.Fields.Count 
      Next oRangeStory 
      Exit Function 
   End If 
      
   'loop fields and count for property
   'delimit with space so name is exact match
   psPropertyName =  " " & psPropertyName &  " "
   For Each oRangeStory In poWordDocument.StoryRanges 
      For Each oField In oRangeStory.Fields 
         If InStr(oField.Code,psPropertyName) > 0 Then 
            Word_CountField = Word_CountField + 1 
         End If 
      Next oField 
   Next oRangeStory 
    
Proc_Exit: 
   On Error GoTo 0 
   Set oField = Nothing 
   Exit Function 
  
Proc_Err: 
   MsgBox Err.Description _ 
       ,, "ERROR " & Err.Number _ 
        &  "   Word_CountField"

   Resume Proc_Exit 
   Resume 
      
End Function 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           run_Word_CountField_ActiveDocument
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Sub run_Word_CountField_ActiveDocument() 
'240119
   'click HERE
   'press F5 to run on ActiveDocument
   Dim nCount As Long _ 
      ,sMsg As String 
   
   nCount = Word_CountField(ActiveDocument) 
   
   sMsg = Format(nCount, "#,##0") _ 
      &  " field" _ 
      & IIf(nCount  1, "s", "") _ 
      &  " in ActiveDocument"

   MsgBox sMsg,, "Count Fields"
   
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           run_Word_CountField_ActiveDocument_PromptPropertyName
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Sub run_Word_CountField_ActiveDocument_PromptPropertyName() 
'240119
   'click HERE
   'press F5 to run on ActiveDocument
   'prompt for property name to count
   
   Dim nCount As Long _ 
      ,sMsg As String _ 
      ,sPropertyName As String 
   
   sMsg =  "Property Name to count fields for " _ 
      &  "(Nothing for whole document)"
   
   sPropertyName = InputBox(sMsg, "") 
   
   sMsg =  "# Fields"
   
   If sPropertyName   "" Then 
      sMsg = sMsg &  " for " & sPropertyName 
   Else 
      sMsg =  " in document"
   End If 
   
   sMsg = sMsg &  " = "
   
   nCount = Word_CountField(ActiveDocument,sPropertyName) 
   
   sMsg =  "Document: " & ActiveDocument.Name _ 
         & vbCrLf & vbCrLf _ 
      & sMsg _ 
      & Format(nCount, "#,##0") 

   MsgBox sMsg,, "Count Fields"
   
End Sub 
'*************** Code End *******************************************************