[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 ! :D
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]

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... :mbe:
Se il doc. è completamente vuoto mi da :

Conteggio completo :
Parole : 0
Caratteri spazi inclusi : 0

http://thumbnails6.imagebam.com/542/e5c5745416844.gif (http://www.imagebam.com/image/e5c5745416844)

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... :confused:

[ramo102e]

A me non succede... :mbe:
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]

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! :D