De: "Fr&eacute;d&eacute;ric Sigonneau" <frederic.sigonneau@wanadoo.fr>
Objet: Re: Comptage des mots
Date : vendredi 31 août 2001 00:37

Bonsoir,

J'ai modifi&eacute; un peu le code pour que le r&eacute;sultat de l'examen d'un dossier soit
renvoy&eacute; dans un classeur. En colonne A, les noms et chemins des classeurs
examin&eacute;s, en colonne B le nombre de mots trouv&eacute;s dans chacun d'eux. En C2 le
total des mots trouv&eacute;s dans l'ensemble des classeurs.
J'ai corrig&eacute; l'erreur not&eacute; par Daniel.
Avec 150 fichiers à examiner ça va sans doute prendre de longues minutes mais ça
devrait quand même être plus rapide que ta m&eacute;thode actuelle :-)
Avec la proposition de Daniel d'utiliser une fonction de la macro XLL de Laurent
Longre (qui offre en plus la possibilit&eacute; de fournir un choix de d&eacute;limiteurs), ça
serait certainement plus rapide. Le langage utilis&eacute; est sans comparaison avec
VBA, mais ça suppose quand même de l'avoir install&eacute;, ce qui ne doit pas être
ton cas.

Pour tester recopie le code dans un module standard (de ton perso.xls si ça te
convient et que tu veux l'avoir toujours sous la main) et affecte la proc&eacute;dure
Compte à un bouton d'une barre d'outils. Puis...clic sur le bouton !

Bon courage
FS
-- 
Fr&eacute;d&eacute;ric Sigonneau [n&eacute; un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau

'===========================dans un module standard
Public Li&

Sub Compte()
Dim Dossier$, wbk As Workbook, derLi&

  Dossier = ChoisirDossier 'choix du dossier à examiner
  
  'classeur de renvoi des comptes
  set wbk = Workbooks.Add
  wbk.ActiveSheet.Name = "Compte des mots"
  With wbk.ActiveSheet
    Cells(1, 1).Value = "Classeur"
    Cells(1, 2).Value = "Nb de mots"
    Cells(1, 3).Value = "Total g&eacute;n&eacute;ral"
    With Range("A1:C1,C2")
      .HorizontalAlignment = xlCenter
      .Interior.ColorIndex = 36
      With .Font
        .Name = "Arial": .Bold = True: .Size = 11
      End With
      With .Borders
        .LineStyle = xlContinuous: .Weight = xlThick
      End With
    End With
  End With
  
  Li = 1
  Application.ScreenUpdating = False
  CompteTousLesMots Dossier, wbk
  Application.ScreenUpdating = True
  
  derLi = wbk.Sheets(1).UsedRange.Rows.Count
  wbk.Sheets(1).Cells(2, 3).FormulaLocal = "=Somme(B2:B" & derLi & ")"
  wbk.Sheets(1).Columns("A:C").AutoFit

End Sub

Sub CompteTousLesMots(LeDossier$, Classeur As Workbook)
Dim fso As Object, Dossier As Object, sousRep As Object, fich As Object
Dim sht As Worksheet, Compteur&
'Static Li&

  set fso = CreateObject("Scripting.FileSystemObject")
  set Dossier = fso.GetFolder(LeDossier)
  
  'examen du dossier courant
  For Each fich In Dossier.Files
    If UCase(fso.GetExtensionName(fich.Name)) = "XLS" Then
      Compteur = 0: Li = Li + 1
      Classeur.Sheets(1).Range("A" & Li).Value = fich.Path
      Workbooks.Open Filename:=fich.Path, UpdateLinks:=0
      For Each sht In ActiveWorkbook.Sheets
        sht.Activate
        'd&eacute;compte des mots par feuille
        Compteur = Compteur + CompteMots(sht.UsedRange)
      Next
      ActiveWorkbook.Close False
      Classeur.Sheets(1).Range("B" & Li).Value = Compteur
    End If
  Next
  
  'traitement r&eacute;cursif des sous dossiers
  For Each sousRep In Dossier.SubFolders
    CompteTousLesMots sousRep.Path, Classeur
  Next sousRep
  
  set fso = Nothing

End Sub

Function CompteMots(Plage As Range) As Long
Dim Cell As Range

  For Each Cell In Plage
    '&eacute;limine du d&eacute;compte les cellules contenant
    'seulement un nombre ou une date
    If Not IsNumeric(Cell.Value2) Then
      CompteMots = CompteMots + UBound(Split(Cell.Text, " ")) + 1
    End If
  Next
  
End Function

Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash
                                            
    set objShell = CreateObject("Shell.Application")
    set objFolder = _
        objShell.BrowseForFolder(&H0&, "Choisisser un r&eacute;pertoire", &H1&)
    On Error Resume Next
    chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    If objFolder.Title = "Bureau" Then
        chemin = "C:\Windows\Bureau"
    End If
    If objFolder.Title = "" Then
        chemin = ""
    End If

    SecuriteSlash = InStr(objFolder.Title, ":")

    If SecuriteSlash > 0 Then
        chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoisirDossier = chemin
End Function
'===================================================

Woups a &eacute;crit :
> 
> Bonjour
> 
> "popi" <popi@infonie.fr> a &eacute;crit dans le message news:
> uCfesvUMBHA.1572@tkmsftngp03...
> > Salut Woups, je rentre dans la conversation à la fin juste pour une
> > suggestion :
> > après l'excellent travail de Fr&eacute;d&eacute;ric (que je m'empresse de mettre de cot&eacute;
> > pour tester) il serait peut-être judicieux d'en utiliser un bout pour te
> > confectionner une macro qui te permettes dor&eacute;navant, par ex à chaque
> > fermeture d'un classeur concern&eacute; par ta r&eacute;mun&eacute;ration de t'informer dans
> une
> > cellule quelconque ou dans un aute fichier (txt par ex) du nb de mots de
> ce
> > classeur, ce qui t'&eacute;viterais par la suite ce travail fastidieux !
> > Qu'en penses-tu ?
> 
> Je pense effectivement que se serait deja plus simple que lors de la
> fermeture si je demande l'action qu'il creer un fichier txt (par exemple)
> pour le donner le nbr de mot avec le nom du fichier qui veint juste de
> fermer. Oui se serait bien.
> 
> Serait il possible d'avoir le dernier code apres les nombreuses
> interventions??
> 
> Je ne suis pas très doue.
> 
> Merci beaucoup pour cette aide. J'avoue que je n'en n'esperais pas autand.
> 
> William
 