[VBA] Word - Conteggio caratteri

[ramo102e]

Ciao a tutti, ho una macro VBA di Word che dovrebbe contare tutti i caratteri presenti in un documento, compresi quelli che Word stesso esclude dal conteggio, come header e footer (le note a pie' di pagine si possono facilmente includere o meno).
Il problema e' che la suddetta macro, non appena inserico nel documento una nota o un header/footer, sballa il conteggio aumentando di 4 il numero di parole e caratteri presenti.

Ecco il codice:

Option Explicit

Sub CountAllCharacters()

Dim ostory As Object
Dim caratteri As Long, Parole As Long, CaratteriWord As Long, ParoleWord As Long, CaratteriSelezione As Long, ParoleSelezione As Long
Dim Percent As Integer
Dim RigheSelezioneArr As Integer
Dim Selezione As Range
Dim Righe As Double, CartelleSelezione As Double, RigheSelezione As Double, Cartelle As Double
Dim MessaggioSelezione As String, MessaggioDiverso As String, Messaggio As String
Dim RigheArr

For Each ostory In ActiveDocument.StoryRanges
caratteri = caratteri + ostory.ComputeStatistics(wdStatisticCharactersWithSpaces)
Parole = Parole + ostory.ComputeStatistics(wdStatisticWords)

Do While Not (ostory.NextStoryRange Is Nothing)

Set ostory = ostory.NextStoryRange
caratteri = caratteri + ostory.ComputeStatistics(wdStatisticCharactersWithSpaces)
Parole = Parole + ostory.ComputeStatistics(wdStatisticWords)

Loop
Next ostory

CaratteriWord = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticCharactersWithSpaces)
ParoleWord = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticWords)

Cartelle = caratteri / 1500
Cartelle = Round(Cartelle, 2)

Righe = caratteri / 55
RigheArr = -Int(-Righe)
Righe = Round(Righe, 2)

 
If Not Selection.Start = Selection.End Then
     
    CaratteriSelezione = Selection.Range.ComputeStatistics(Statistic:=wdStatisticCharactersWithSpaces)
    ParoleSelezione = Selection.Range.ComputeStatistics(Statistic:=wdStatisticWords)

    CartelleSelezione = CaratteriSelezione / 1500
    CartelleSelezione = Round(CartelleSelezione, 2)
 
    RigheSelezione = CaratteriSelezione / 55
    RigheSelezioneArr = -Int(-RigheSelezione)
    RigheSelezione = Round(RigheSelezione, 2)

    Percent = CaratteriSelezione * 100 / caratteri

    MessaggioSelezione = "Conteggio nella selezione:" & vbCr _
         & "  parole:                             " & ParoleSelezione & vbCr _
         & "  caratteri spazi inclusi:      " & CaratteriSelezione & vbCr _
         & "  cartelle:                           " & CartelleSelezione & vbCr _
         & "  righe:                               " & RigheSelezioneArr & " (" & RigheSelezione & ")" & vbCr & vbCr _
         & "La selezione corrisponde al " & Percent & "% del testo totale." & vbCr _
         & "_____________________________________________________" & vbCr & vbCr

End If

 
If caratteri <> CaratteriWord Then

    MessaggioDiverso = "Conteggio di Word:" & vbCr _
         & "  parole:                             " & ParoleWord & vbCr _
         & "  caratteri spazi inclusi:      " & CaratteriWord & vbCr _
         & "_____________________________________________________" & vbCr & vbCr

End If

 
Messaggio = "Conteggio comprensivo di cornici di testo, pié di pagina, note, ecc." & vbCr _
         & "_____________________________________________________" & vbCr & vbCr _
         & MessaggioSelezione _
         & MessaggioDiverso _
         & "Conteggio completo:" & vbCr _
         & "  parole:                             " & Parole & vbCr _
         & "  caratteri spazi inclusi:      " & caratteri & vbCr _
         & "  cartelle:                           " & Cartelle & vbCr _
         & "  righe:                               " & RigheArr & " (" & Righe & ")" & vbCr _
         & "_____________________________________________________" & vbCr & vbCr _
         & "                                 Buon lavoro!!!"

 
MsgBox Messaggio, 64

End Sub

Faccio un esempio: se aggiungo come header la parola "Intestazione" mi aspetterei di avere il risultato:
word: 1 characters: 12
Invece ottengo:
word: 5 characters: 16

Successivamente invece il conteggio dei caratteri di queste entita' avviene correttamente.
Qualcuno sa come correggerlo? Grazie!

[MarcoGG]

Capita, quando si copia/incolla una macro che non è farina del nostro sacco !
L' ho provata anch'io ed effettivamente aggiunge 4 solo se nell'Header del documento esiste almeno un carattere...
Perciò la cosa può essere risolta semplicemente con una piccola aggiunta in questa sezione del codice :

...
...
    If caratteri <> CaratteriWord Then
    
        MessaggioDiverso = "Conteggio di Word:" & vbCr _
             & "  parole:                             " & ParoleWord & vbCr _
             & "  caratteri spazi inclusi:      " & CaratteriWord & vbCr _
             & "_____________________________________________________" & vbCr & vbCr
    
    End If
    
    With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
        If .Range <> "" Then
            Parole = Parole - 4
            caratteri = caratteri - 4
        End If
    End With
         
    Messaggio = "Conteggio comprensivo di cornici di testo, pié di pagina, note, ecc." & vbCr _
             & "_____________________________________________________" & vbCr & vbCr _
             & MessaggioSelezione _
             & MessaggioDiverso _
             & "Conteggio completo:" & vbCr _
             & "  parole:                             " & Parole & vbCr _
             & "  caratteri spazi inclusi:      " & caratteri & vbCr _
             & "  cartelle:                           " & Cartelle & vbCr _
             & "  righe:                               " & RigheArr & " (" & Righe & ")" & vbCr _
             & "_____________________________________________________" & vbCr & vbCr _
             & "                                 Buon lavoro!!!"
    
     
    MsgBox Messaggio, 64

Prova, .

[ramo102e]

In questo caso funziona se il documento presenta un header o un footer con qualcosa scritto dentro, altrimenti il conteggio viene ugualmente diminuito di quattro unita' (in un documento vuoto si ottiene parole: -4, caratteri: -4).
E' possibile evitarlo?

[MarcoGG]

Originariamente inviato da ramo102e

In questo caso funziona se il documento presenta un header o un footer con qualcosa scritto dentro, altrimenti il conteggio viene ugualmente diminuito di quattro unita' (in un documento vuoto si ottiene parole: -4, caratteri: -4).
E' possibile evitarlo?

A me non succede...
Se il doc. è completamente vuoto mi da :

Conteggio completo :
Parole : 0
Caratteri spazi inclusi : 0



Sicuro di aver inserito il mio codice ( rosso ) nella posizione corretta ?

[ramo102e]

In realta' ho notato che il -4 lo da' solo nel primo conteggio, dal secondo in poi funziona benissimo.
Ci sara' qualcosa da inizializzare (conta 4 caratteri e parole all'interno del loop delle "ostory"), ma dal debug non sono riuscito a capire dove li vada a prendere...

[ramo102e]

Originariamente inviato da MarcoGG

A me non succede...
Se il doc. è completamente vuoto mi da :

Conteggio completo :
Parole : 0
Caratteri spazi inclusi : 0

Sicuro di aver inserito il mio codice ( rosso ) nella posizione corretta ?

Si, ho inserito nel posto giusto.
Ma funziona come ti ho detto. Magari dipende dalla versione di Office: io sto usando la 2003...

[MarcoGG]

Originariamente inviato da ramo102e

Si, ho inserito nel posto giusto.
Ma funziona come ti ho detto. Magari dipende dalla versione di Office: io sto usando la 2003...

No, non dipende da quello. Anch'io ho il 2003.
Comunque sostituisci il mio precedente codice rosso con questo, e andrà bene per forza :

    With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
        If .Range <> "" Then
            Parole = Parole - 4
            caratteri = caratteri - 4
        End If
    End With
    If Parole < 0 Then Parole = 0
    If caratteri < 0 Then caratteri = 0

[ramo102e]

Yes, ci avevo pensato anch'io... grazie per la soluzione!