[Résolu] nombre de signes espaces non compris

[Pierre2M]

Bonjour,

Je viens encore profiter de votre expérience et votre bonté en espérant seulement que mes questions pourront en aider d'autres.

J'écris dans un petit magazine où il faut compter le nombre de signes espaces non compris ce qui se fait aisément sous MS Word soit par les statistiques soit en insérant le champs adéquoit.

Dans OOo Writer je n'ai trouvé que le décompte des signes espaces compris. cela m'oblige a repasser sous Word pour vérifier le nombre de signes ce que j'aimerai éviter.

Y a-t-il une solution (autre que le comptage manuel un peut fastidieux... ) ?

[Dude]

Je dirais :

Nombre de caractères - nombre de mots -1

[Pierre2M]

Je dirais :

Nombre de caractères - nombre de mots -1

oui, j'avais pas pensé à une opération si simple... ça fonctionne assez bien (à quelques dizaines de signes prets). mais pourquoi le -1 ?

ceci dit, y a-til un moyens plus automatique, comme sous Word ?

[vinc-mai]

-1 car il y a "normalement" un espace de moins que le nombre de mot dans un texte.

[Pierre2M]

-1 car il y a "normalement" un espace de moins que le nombre de mot dans un texte.

ne serait-ce pas plutôt -1 / paragraphes ?

[vinc-mai]

ne serait-ce pas plutôt -1 / paragraphes ?

Je dirais même plus: -1*par le nombre de paragraphes.
Ce qui nous ferait: Nombre de caractères - (nombre de mots -nombre de paragraphe).

A vérifier.

[Dude]

Ce qui nous ferait: Nombre de caractères - (nombre de mots -nombre de paragraphe).

Exact ! Sinon, une macro qui calcule le nombre d'espaces et qui le retranche au nombre de caractères.

[Pierre2M]

une macro qui calcule le nombre d'espaces et qui le retranche au nombre de caractères.

Une telle macro existe-t-elle ?
Si non est-ce facilement réalisable ?

[Dude]

Code : Tout sélectionner

Sub CompteCaracteres
   Dim oDoc      As Object
   Dim oText      As Object
   Dim oParser      As Object
   Dim oUrl      As New com.sun.star.util.URL
   Dim b         As String
   Dim t         As String
   ' Déclaration des compteurs...
   Dim sc         As Long ' espace
   Dim lc         As Long ' lettre
   Dim dc         As Long   ' chiffre
   Dim rc         As Long   ' retour chariot
   Dim oc         As Long   ' autre

   oDoc = ThisComponent.CurrentController.Frame
   oParser = createUnoService("com.sun.star.util.URLTransformer")
   oDoc = ThisComponent
   oText = oDoc.Text
   
   t = Left( oText.String, 100 )
   For p = 1 To Len( t )
      Select Case Mid( t, p, 1 )
         Case "a" To "z", "A" To "Z", "0" To "9"
            b = Mid( t, p, 50 )
            Exit For
      End Select
   Next p

   ' obtenir les compteurs
   n = 1
   Do

      t = Mid( oText.String, n, 64000 )
      n = n + 64000
   
      For p = 1 To Len( t )

         Select Case Mid( t, p, 1 )
      
            Case "a" To "z", "A" To "Z"
               lc = lc + 1
            Case " ", Chr( 9 ) ' tabulation et espace
               sc = sc + 1
            Case "0" To "9"
               dc = dc + 1
            Case Chr( 13 )
               rc = rc + 1
            Case Chr( 10 )
               ' à ignorer
            Case else
               oc = oc + 1
         End Select
      
      Next p
   
   Loop While Len( t ) = 64000

   ' envoi le résultat
   t = "Nombre de lettres + chiffres " & Str( lc + dc ) & Chr(13) & Chr(10)
   MsgBox t

End Sub

Pour info, il y a un nombre énorme d'issues sur ce sujet.

[Pierre2M]

OK, merci !

C'est dingue, j'avais posé la même question sur le forum officiel avant de découvrir celui là sans obtenir de réponse et ici, en quelques heures s'est un affaire réglée...

Bon, prèsque réglée, je n'ai encore jamais créé de macros mais je m'attaquerai à ça demain ou 1 de ces 4...
donc merci encore...

[Hagar Delest]

Pour info, la macro ne fonctionne que pour des textes dont la longueur n'excède pas 65536 caractères (la fameuse limite du paragraphe maxi), caractères non imprimables inclus. Sinon, tous les compteurs sont à zéro !

NB: j'ai un peu nettoyé le code :

Code : Tout sélectionner

Sub CharactersCount
Dim oDoc      As Object
Dim oText     As Object
Dim b         As String
Dim t         As String
' Counters definition
Dim sc         As Long   ' space
Dim lc         As Long   ' letter
Dim dc         As Long   ' digit
Dim rc         As Long   ' carriage return
Dim oc         As Long   ' other

oDoc = ThisComponent
oText = oDoc.Text

' Get the counts
n = 1
Do
	t = Mid(oText.String, n, 65000)
	n = n + 65000
    For p = 1 To Len(t)
    	Select Case Mid(t, p, 1)
        	Case "a" To "z", "A" To "Z"    ' letters
            	lc = lc + 1
			Case " ", Chr(9)          ' tabulation and spaces
            	sc = sc + 1
			Case "0" To "9"             ' digits
				dc = dc + 1
			Case Chr(13)             ' carriage returns
				rc = rc + 1
			Case Chr(10)
			' to be ignored
			Case else
				oc = oc + 1
		End Select
	Next p
Loop While Len(t) = 65000

' Show the results
t = "Alphanumerical characters: " & Str( lc + dc ) & Chr(13) & Chr(10) _
& "Spaces and tabulations : " & Str(sc) & Chr(13) & Chr(10) _
& "Others (punctuation, ...): " & Str(oc) & Chr(13) & Chr(10) _
& "Total: " & Str(lc+dc+sc+oc) & Chr(13) & Chr(10) _
& "Total minus spaces and tabs: " & Str(lc+dc-sc)
MsgBox t,0,"Custom count"

End Sub

[ThierryM]

Bonjour à tous,
Je me permets de rajouter une mise en garde dans ce fil qui date un peu...
Attention, les caractères spécifiques au français (comme les accents ou les cédilles) ne sont pas pris en compte dans les macros ci-dessus.
Il faudrait rajouter d'autres "CASE" pour tenir compte de ces caractères exotiques chez nos amis anglophones (cf ce fil pour avoir d'autres "CASE" : http://user.services.openoffice.org/fr/ ... =8&t=20505).
Cordialement,

Thierry