XL 2016 Récupérer le nombre de mots d'un fichier word

[kalem]

Bonjour à tous, j'ai besoin de vos lumières, encore une fois.
Je dois écrire un rapport assez long et j'aimerais créer un fichier avec :
- en colonne A : la date du jour
- en colonne B : le nombre de mots écrits sur mon document word contenant le rapport. Ce que je voudrais, c'est qu'Excel récupère directement cette donnée sans que j'aie à la rentrer.
Cela me permettrait de suivre l'évolution et mon rythme d'écriture, sans avoir à remplir le tableau.
Dans les colonnes suivantes, je pense que j'indiquerais mon avance/retard, le nombre de mots par jour, etc.
Savez-vous si c'est possible ?
Merci d'avance.

 

[eriiic]

Bonjour,

te sort :

Sub test()
    Const doc As String = "E:\Téléchargement Chrome\Fonction XLOOKUP.docx"
    Dim rep, lig As Long
    rep = statsDoc(doc)
    If IsError(rep) Then
        MsgBox "Fichier non trouvé"
    Else
        lig = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(lig, 1) = Now
        Cells(lig, 2).Resize(, 6) = rep
    End If
End Sub

Function statsDoc(d As String, Optional IncludeFootnotesAndEndnotes As Boolean = False)
    Dim wdDoc As Object, stats(1 To 1, 0 To 5) As Long, i As Long
    If Dir(d) = "" Then
        statsDoc = CVErr(xlErrValue)
    Else
    Set wdDoc = GetObject(d)
    For i = 0 To 5
        stats(1, i) = wdDoc.ComputeStatistics(i, IncludeFootnotesAndEndnotes)
    Next i
    Set wdDoc = Nothing
    statsDoc = stats
    End If
End Function

adapte i si tu ne veux vraiment que les mots.

Si ça t'intéresse j'avais aussi fait une macro word pour lister les fréquences des mots utilisés.
eric

 

[job75]

Bonjour kalem, eriiiic,

Avec le document Word nommé "DocWord.docx" et placé dans le même répertoire que le fichier Excel exécutez cette macro :

Sub Mots_Word()
Dim chemin$, doc$, objWord As Object, c As Range
chemin = ThisWorkbook.Path & "\" 'à adapter
doc = "DocWord.docx" 'nom du document Word, à adapter
If Dir(chemin & doc) = "" Then MsgBox "'" & chemin & doc & "' introuvable !": Exit Sub
Set objWord = GetObject(chemin & doc)
objWord.Application.Visible = True
Set c = Range("A" & Rows.Count).End(xlUp)(2)
c = Now 'date/heure
c(1, 2) = objWord.Words.Count - 1 'nombre de mots
End Sub

A+

 

[eriiic]

Bonjour job,

c'est quoi la plus-value ?
eric

 

[job75]

C'est juste plus court et ça répond mieux à la question posée.

 

[eriiic]

Ah...
Qui peut le plus peut le moins.
J'avais précisé : adapte i si tu ne veux vraiment que les mots.
eric

 

[mapomme]

Bonjour à @kalem, @eriiiic , @job75

Une autre piste (et ne me demandez pas pourquoi ? )

• Double-cliquer sur les cellules en jaune.

nota: si le nom du fichier ne comporte ni "\" et ni ":"", alors on suppose que le fichier est dans le répertoire du fichier excel.

Le code pour compter les mots:

Sub NbrMotsDoc(Cellule As Range, Fichier As Range)
Dim Chemin$, Fic$, WordApp, WordDoc
   Cellule = "Calcul..."
   With Fichier.Cells(1)
      If InStr(.Value, "\") = 0 And InStr(.Value, ":") = 0 Then Fic = ThisWorkbook.Path & IIf(Right(ThisWorkbook.Path, 1) = "\", "", "\") & .Value Else Fic = .Value
   End With
   On Error GoTo Err001: Set WordApp = CreateObject("Word.Application")
   WordApp.Visible = False
   Set WordDoc = WordApp.Documents.Open(Filename:=Fic, ReadOnly:=True)
   Cellule.Value = WordDoc.Range.ComputeStatistics(0)
   WordApp.Quit False
   Exit Sub
Err001:
   Cellule = "Echec : " & Err.Description
End Sub

 

[kalem]

Mais c'est génial !!!! Merci beaucoup, je vais tester tout ça !
Et oui, Eric, une astuce pour identifier les mots les plus utilisés, je suis preneur !
Merci à tous.

 

[eriiic]

Re,

la version avec une statistiques sur les mots.
En début de code tu as des constantes à adapter selon ton besoin
Je l'ai mise avec demande de validation car selon la taille du doc ça risque de prendre qq secondes, je pense que le besoin est plus ponctuel.
eric

Edit: ajout déclaration variable oubliée

 

[kalem]

Merci bien éric.
je teste, mais j'ai l'impression qu'il y a un souci : "erreur de compilation, variable non définie". Je crois que c'est cette partie du code qui m'embête.

Sub statsMots(wdDoc As Object)
    Dim wd, dict, k, result(), i As Long, tmp
    Dim nb As Long, idx As Long
    Set dict = CreateObject("Scripting.Dictionary")
    nbMax = Application.Min(nbMaxMots, 65536)

La première ligne est surlignée, et nbmax est sélectionné... J'avoue que ça dépasse de loin mes compétences.

 

[Santulud]

Bonjour,

la variable nbMax n'a pas été définie.
Modifie comme suit :

Sub statsMots(wdDoc As Object)
Dim wd, dict, k, result(), i As Long, tmp
Dim nb As Long, idx As Long, nbMax as Long
Set dict = CreateObject("Scripting.Dictionary")
nbMax = Application.Min(nbMaxMots, 65536)

 

[eriiic]

Ah oui, exact.
Je l'ai ajoutée en dernière minute mais oublié de changer le fichier.
Merci Santulud

 

[Santulud]

De rien

 

[kalem]

C'était ça !
C'est brillant, merci à vous...