Resumen de selección de palabras

VBA

Módulo estándar

Este código se ejecuta en Word y obtiene información sobre la selección.

Option Explicit 

'*************** Code Start *****************************************************
' module name: mod_Word_SelectionSummary_s4p
'-------------------------------------------------------------------------------
' Purpose  : read information about the selection
'              where and what it is, and # of:
'              paragraphs, words, characters,
'              bookmarks, comments, fields
' Author   : crystal (strive4peace)
' Code List: 
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Use at your own risk.
'-------------------------------------------------------------------------------
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           Word_SelectionSummary_s4p
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub Word_SelectionSummary_s4p() 
'230826 s4p

   'CALLS
   '  GetStoryType
   
   On Error GoTo Proc_Err 
   
   Dim sDocumentName As String _ 
      ,sMsg As String _ 
      ,sStartsWith As String _ 
      ,nCountPara As Long _ 
      ,nCountWord As Long _ 
      ,nCountChar As Long _ 
      ,nCountBookmark As Long _ 
      ,nCountComment As Long _ 
      ,nCountField As Long _ 
      ,nStoryType As Long _ 
      ,nPageNumber As Long 
   
   sDocumentName = ActiveDocument.Name 
   sMsg =  "*** selection in " & sDocumentName &  " ***"
   
   With Selection.Range 
      nStoryType = .StoryType 
      ' wdActiveEndPageNumber = 3
      nPageNumber = .Information(wdActiveEndPageNumber) 
      
      sStartsWith = Left(.Paragraphs(1).Range.Text,50) 
      
      nCountPara = .Paragraphs.Count 
      nCountWord = .Words.Count 
      nCountChar = .Characters.Count 
      On Error Resume Next 
      nCountBookmark = .Bookmarks.Count 
      nCountComment = .Comments.Count 
      nCountField = .Fields.Count 
   End With  'Selection.Range
   
   On Error GoTo Proc_Err 
   
   sMsg = sMsg _ 
      & vbCrLf &  "  StoryType= " & nStoryType &  " " & GetStoryType(nStoryType) _ 
      & vbCrLf &  "  Page Number = " & nPageNumber _ 
      & vbCrLf &  "  Starts With = " & sStartsWith _ 
      & vbCrLf &  "  #Paragraphs= " & Format(nCountPara, "#,##0") _ 
      & vbCrLf &  "  #Words= " & Format(nCountWord, "#,##0") _ 
      & vbCrLf &  "  #Characters= " & Format(nCountChar, "#,##0") _ 
      & vbCrLf &  "  #Bookmarks= " & nCountBookmark _ 
      & vbCrLf &  "  #Comments= " & nCountComment _ 
      & vbCrLf &  "  #Fields= " & nCountField 

   Debug.Print sMsg 
   MsgBox sMsg,, "Word_SelectionSummary_s4p"
      
Proc_Exit: 
   On Error GoTo 0 
   Exit Sub 
  
Proc_Err: 
   MsgBox Err.Description _ 
       ,, "ERROR " & Err.Number _ 
        &  "   Word_SelectionSummary_s4p"

   Resume Proc_Exit 
   Resume 
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           GetStoryType
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function GetStoryType(pWdStoryType As Long) As String 
'230826 s4p
   Select Case pWdStoryType 
      Case 1: GetStoryType =  "Main text"
      Case 2: GetStoryType =  "Footnotes"
      Case 3: GetStoryType =  "Endnotes"
      Case 4: GetStoryType =  "Comments"
      Case 5: GetStoryType =  "Text frame"
      Case 6: GetStoryType =  "Even pages header"
      Case 7: GetStoryType =  "Primary header"
      Case 8: GetStoryType =  "Even pages footer"
      Case 9: GetStoryType =  "Primary footer"
      Case 10: GetStoryType =  "First page header"
      Case 11: GetStoryType =  "First page footer"
      Case 12: GetStoryType =  "Footnote separator"
      Case 13: GetStoryType =  "Footnote continuation separator"
      Case 14: GetStoryType =  "Footnote continuation notice"
      Case 15: GetStoryType =  "Endnote separator"
      Case 16: GetStoryType =  "Endnote continuation separator"
      Case 17: GetStoryType =  "Endnote continuation notice"
      Case Else: GetStoryType = pWdStoryType 
   End Select  'pWdStoryType
End Function 

'*************** Code End *******************************************************

‘ El código se generó con colores utilizando el complemento gratuito Color Code para Access