Discussion :

[Krovax]

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é

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

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

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

[Heureux-oli]

Salut,

Perso, je préfère utiliser le FSO (FileSystemObject) pour parcourir les objets d'un répertoire.
Et pour récupérer les informations d'un fichier Word, le DSO permet de ne pas ouvrir le document avec l'application.

Maintenant, tu ne nous dis pas si tu pars de Word ou d'un autre logiciel ?

Pour le DSO :
http://heureuxoli.developpez.com/off.../variables/#L5

Pour le FSO :
http://warin.developpez.com/access/fichiers/

[Krovax]

Bonjour, je lance la macro a partir de word, par contre avec DSO on obtient toujours une seule page. Après il y a peut être une erreur dans le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub proprietesFichiersDso()
 
Dim oDso As DSOFile.OleDocumentProperties
Dim resultat As String
 
Set oDso = New DSOFile.OleDocumentProperties
 
oDso.Open sfilename:="C:\Test\Doc4.doc"
resultat = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
MsgBox resultat
End Sub

[Krovax]

Le code finalement 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
29
30
31
32
33
34
Sub OuvrirWord()
Dim i As Integer, derpage As Integer, 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
      Documents.Open Application.FileSearch.FoundFiles(k)
      Documents(Application.FileSearch.FoundFiles(k)).Activate
 
      With ActiveDocument
          Selection.EndKey Unit:=wdStory
          derpage = Selection.Information(wdActiveEndPageNumber)
      End With
 
      If derpage <= 7 Then
          Documents(Application.FileSearch.FoundFiles(k)).Close savechanges:=False
      End If
  Next k
End If
 
Next i
Application.ScreenUpdating = True

[Heureux-oli]

Salut,

Surprenant, je viens d'essayer

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
29
30
31
32
33
34
35
36
37
 
Sub proprieteDocument()
Dim oDSO As DSOFile.OleDocumentProperties
Dim oFSO As FileSystemObject
Dim ofol As Folder
Dim ofil As File
Dim prop As DSOFile.SummaryProperties
Dim oDlg As FileDialog
 
Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
Set oFSO = New FileSystemObject
Set oDSO = New DSOFile.OleDocumentProperties
oDlg.Show
 
Set ofol = oFSO.GetFolder(oDlg.SelectedItems(1))
 
 
 
 
For Each ofil In ofol.Files
 
 
If Right(ofil.Name, 4) = "docm" Or Right(ofil.Name, 4) = "docx" Then
oDSO.Open sFileName:=ofil.Name
Debug.Print ofil.Name & " - " & oDSO.SummaryProperties.PageCount
oDSO.Close
End If
 
 
Next ofil
Set oDlg = Nothing
Set ofol = Nothing
Set oFSO = Nothing
Set oDSO = Nothing
 
 
End Sub

Et tout fonctionne correctement.