Bonjour,
On a besoin de connaitre le nombre de page de chacun des fichiers word d'un dossier. Boucler sur le contenu du répertoire pas de problème. Le problème est de récupérer le nombre de page. Voici le code utilisé
Le problème étant que par cette méthode on obtient toujours 1 page (manuellement on a le même résultat) quelque soit le nombre de page du fichier...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 'Necessite d'activer la reference Microsoft Shell Controls and Automation ' Dim objShell As Object, strFileName As Object Dim objFolder As Folder Dim Resultat As String Dim i As Byte Set objShell = CreateObject("Shell.Application") 'repertoire cible Set objFolder = objShell.nameSpace("C:\Test") 'boucle sur tous les elements du repertoire For Each strFileName In objFolder.Items 'pour que les sous dossiers ne soient pas pris en comptes If strFileName.isFolder = False Then Resultat = objFolder.getDetailsOf(strFileName, 13) MsgBox Resultat End If Next End Sub
Si quelqu'un a une solution
Ps : la version Ouvrir compter fermer pose quelque souci, le code va tourner sur une espèce de vieux machin, et du coup l'ouverture ne semble pas s'achever avant le passage a la ligne de code suivante (en mode pas a pas ca passe tout seul )
Le code utilisé
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28 Sub OuvrirWord() Dim nbpage As Integer, i As Integer, j As Long, k As Integer, trouve As Integer Dim nomdoc As String Application.ScreenUpdating = False For i = 2 To 5 trouve = 0 nomdoc = "C:\Test\Doc" & i & ".doc" With Application.FileSearch .FileName = "Doc" & i & ".doc" .LookIn = "C:\Test\" .Execute trouve = .FoundFiles.Count End With If trouve >= 1 Then For k = 1 To trouve set docu=Documents.Open Application.FileSearch.FoundFiles(k) DoEvents 'qui n'a rien changé a son arrivé nbpage = docu.BuiltInDocumentProperties("Number of Pages").Value If nbpage <= 7 Then Documents(docu.Name).Close savechanges:=False End If Next k End If Next i Application.ScreenUpdating = True End Sub
Partager