Note: The other languages of the website are Google-translated. Back to English

Comment compter les numéros de page des fichiers Pdf dans Excel?

S'il existe plusieurs fichiers Pdf dans un dossier spécifique, vous souhaitez maintenant afficher tous ces noms de fichiers dans une feuille de calcul et obtenir les numéros de page de chaque fichier. Comment pourriez-vous gérer ce travail dans Excel rapidement et facilement?

Comptez les numéros de page des fichiers Pdf à partir d'un dossier dans la feuille de calcul avec le code VBA


Comptez les numéros de page des fichiers Pdf à partir d'un dossier dans la feuille de calcul avec le code VBA

Le code VBA suivant peut vous aider à afficher tous les noms de fichiers Pdf et leurs numéros de page dans une feuille de calcul, procédez comme suit:

1. Ouvrez une feuille de calcul dans laquelle vous souhaitez obtenir les fichiers Pdf et les numéros de page.

2. Maintenez le ALT + F11 clés, et il ouvre le Microsoft Visual Basic pour applications fenêtre.

3Cliquez sur insérer > Moduleet collez la macro suivante dans le Module Fenêtre.

Code VBA: Liste tous les noms de fichiers Pdf et numéros de page dans la feuille de calcul:

Sub Test()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Set xRg = Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "File Name"
        xRg.Offset(0, 1) = "Pages"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
End Sub

4. Après avoir collé le code, puis appuyez sur F5 clé pour exécuter ce code, et un DECOUVREZ La fenêtre s'affiche, veuillez sélectionner le dossier contenant les fichiers Pdf que vous souhaitez lister et compter les numéros de page, voir capture d'écran:

nombre de doc pages pdf 1

5. Et puis, cliquez OK bouton, tous les noms de fichiers Pdf et les numéros de page sont répertoriés dans la feuille de calcul actuelle, voir capture d'écran:

nombre de doc pages pdf 2


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2021 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Fonctionnalités complètes Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (71)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
Fonctionne très bien! Merci beaucoup!
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup d'avoir posté un message aussi informatif
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup, excellent code très utile pour moi
Ce commentaire a été minimisé par le modérateur sur le site
Ne fonctionne pas correctement, pour certains pdf, pour certains pdf, il affiche 0 et pour certains numéros de page incorrects
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Fawaz,
Le code fonctionne bien dans mon Excel, quelle version d'Excel utilisez-vous ?
Ou vous pouvez envoyer votre problème détaillé ou des fichiers pdf à mon e-mail : skyyang@extendoffice. Com.
Ce commentaire a été minimisé par le modérateur sur le site
Salut skyyang,

J'ai le même problème que Fawaz. J'utilise MS Office Professionnel Plus 2013.

Merci de votre aide!

Meilleures salutations
Ce commentaire a été minimisé par le modérateur sur le site
La même chose se produit ici, les mêmes pages pdf reviennent à zéro, veuillez expliquer ceci
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, Venkatesh G.
Le code fonctionne bien dans mon Excel, veuillez envoyer vos fichiers pdf à mon e-mail : yy@addin99.com.
Pour que nous puissions vérifier d'où vient le problème, merci !
Ce commentaire a été minimisé par le modérateur sur le site
salutations


Hay algún problema con el programa, yo estoy usando la versión 2019 de Office, y las páginas parece que las va contando de mal las primeras 9 páginas acumuladas me sale cero, en la neuvaine página acumulada me sale 10.

¿Por favor me puedes ayudar con ese inconveniente?

D'avance je vous remercie beaucoup.

Atte.

Pedro
Ce commentaire a été minimisé par le modérateur sur le site
SAINT! C'est génial! Merci beaucoup! Je suis imprimeur et j'ai fait printit.txt et rempli à la main ! Cela va rendre les devis et la vérification des travaux BEAUCOUP PLUS FACILES ! Merci encore!!!
Ce commentaire a été minimisé par le modérateur sur le site
Cordialement

Il y a un problème avec le programme, j'utilise la version 2019 d'Office, et les pages semblent mal compter les 9 premières pages cumulées j'obtiens zéro, dans la neuvième page cumulée j'obtiens 10.

Pouvez-vous s'il vous plaît m'aider avec ce désagrément?

D'avance merci beaucoup.

Atte.

Pedro
Ce commentaire a été minimisé par le modérateur sur le site
Le code est une bonne structure pour savoir comment faire ce genre de chose, mais cette expression rationnelle donnera des résultats peu fiables pour de nombreux fichiers PDF. L'expression régulière recherchée (/Type\s*/Page[^s]) ne fonctionnera pas dans les fichiers PDF SÉCURISÉS (le nombre sera égal à zéro). De plus, les outils et les versions des pdf varient dans la façon dont ils marquent les pages. Cela pourrait être exact si vous savez que tous vos pdf sont créés en utilisant la même structure (version et outils).
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup pour votre réponse, j'ai résolu le problème en enregistrant les fichiers sous : "PDF optimisé"
Ce commentaire a été minimisé par le modérateur sur le site
100% d'accord avec Pedro, j'avais le même problème que Rob où certains nombres de pages PDF étaient erronés. Mais si vous vous assurez que tous les fichiers sont enregistrés en tant que "PDF optimisé" dans le dossier, toutes les pages seront correctes. Cela a fonctionné pour moi sur plus de 100 fichiers PDF distincts. Vous pouvez également optimiser en bloc avec Acrobat Pro. Dans l'ensemble, un excellent code, travaillé dès la sortie de la boîte si vous voulez.
Ce commentaire a été minimisé par le modérateur sur le site
Et si je veux également parcourir les sous-dossiers ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Prashant,
Pour obtenir le nombre de tous les fichiers PDF du dossier et des sous-dossiers, veuillez appliquer le code ci-dessous :

Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
Appeler SunTest(xFdItem, I)
Si fin
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xF comme objet
Dim xSF en tant qu'objet
Dim xFso en tant qu'objet
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Set xFso = CreateObject("Scripting.FileSystemObject")
Définir xF = xFso.GetFolder(xFdItem)
Pour chaque xSF dans xF.SubFolders
Appelez SunTest(xSF.Path & "\", I)
Suivant
End Sub

S'il vous plaît essayez, j'espère que cela peut vous aider!
Ce commentaire a été minimisé par le modérateur sur le site
Votre code de sous-dossier fonctionne bien ! Merci
Ce commentaire a été minimisé par le modérateur sur le site
C'est merveilleux, merci. Je voudrais également parcourir les sous-dossiers. Où/comment ajouter ces commandes supplémentaires dans le code ci-dessus ? à quoi ressemblerait l'ensemble ?
Ce commentaire a été minimisé par le modérateur sur le site
Pouvez-vous m'aider à obtenir également le créateur et les dimensions du fichier ?
Ce commentaire a été minimisé par le modérateur sur le site
C'est vraiment génial. Mais les noms de sous-dossiers n'entrent pas dans une colonne séparée avec les noms de fichiers PDF et le nombre de pages. Pouvez-vous aider à cela?
Ce commentaire a été minimisé par le modérateur sur le site
Fantastique !!!
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
Je vous en prie. Heureux que cela aide. Des questions, n'hesitez pas a nous contacter. Passe une bonne journée.
Sincèrement,
Mandy
Ce commentaire a été minimisé par le modérateur sur le site
Salut Mandy,
J'obtiens une erreur d'exécution '5' : Appel de procédure ou argument non valide
Le débogage va à cette ligne : xStr = Space(LOF(xFileNum))
Ce commentaire a été minimisé par le modérateur sur le site
Je cours mais j'obtiens une erreur et le débogage montre xStr = Space(LOF(xFileNum)) comme problème.
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup.
De même, pouvez-vous compter et catégoriser les pages A3 et A4 ?
Ce commentaire a été minimisé par le modérateur sur le site
Voici le code que j'ai trouvé quelque part sur le net, il n'est pas aussi optimal que votre méthode :
Option explicite
PDFDoc public comme AcroPDDoc, PDFPage comme objet, A3&, A4&

Principal sous()
Dim fso As FileSystemObject, fld As Folder, fil As File, s$, i&, Arr()
Set fso = Nouveau FileSystemObject
Définir PDFDoc = Nouveau AcroPDDoc
Set fld = fso.GetFolder(ThisWorkbook.Path)
Redim Arr(1 à 1000, 1 à 3)
Pour chaque fichier dans fld.Files
s = fil.Nom
Si Droite(s, 4) = ".pdf" Alors
CountPagesPDF (ThisWorkbook.Path & "\" & s)
i = i + 1
Arr(i, 1) = s
Arr(i, 2) = A3
Arr(i, 3) = A4
Si fin
Suivant
Range("A2:C" & Cells.Rows.Count).Effacer
Plage("A2:C" & (i + 1)) = Arr
Définir PDFPage = Rien
Définir PDFDoc = Rien
Définir fso = Rien
End Sub

Sous-nombrePagesPDF(FullFileName$)
Dim i&, n&, x, y
A3 = 0
A4 = 0
PDFDoc.Ouvrir (NomFichierComplet)
n = PDFDoc.GetNumPages
Pour i = 0 À n - 1
Set PDFPage = PDFDoc.AcquirePage(i)
x = PDFPage.GetSize().x
y = PDFPage.GetSize().y
Si x + y > 1500 Alors A3 = A3 + 1 Sinon A4 = A4 + 1
Suivant
PDFDoc.Fermer
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Waouh ! merci beaucoup pour le partage, ce code VBA est un tueur !! Cela fonctionne parfaitement avec Excel O365
Ce commentaire a été minimisé par le modérateur sur le site
wow. les sous-dossiers fonctionnent très bien. pouvez-vous partager comment ajouter "chemin du fichier" et "taille du fichier" aussi ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Daphné,
Pour résoudre votre problème, veuillez appliquer le code ci-dessous, veuillez essayer, j'espère qu'il pourra vous aider !

Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
xRg.Offset(0, 2) = "Chemin"
xRg.Offset(0, 3) = "Taille(b)"
I = 2 XNUMX
Appeler SunTest(xFdItem, I)
Si fin
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xF comme objet
Dim xSF en tant qu'objet
Dim xFso en tant qu'objet
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
Cellules(I, 3) = xFdItem & xFileName
Cellules(I, 4) = FileLen(xFdItem & xFileName)
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Set xFso = CreateObject("Scripting.FileSystemObject")
Définir xF = xFso.GetFolder(xFdItem)
Pour chaque xSF dans xF.SubFolders
Appelez SunTest(xSF.Path & "\", I)
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
C'est tellement génial. Merci!
Ce commentaire a été minimisé par le modérateur sur le site
Salut skyyang,
Désolé de remonter un vieux post.
Merci pour le code ci-dessus, ça m'aide beaucoup!
Auriez-vous la gentillesse de partager comment ajouter la "date de création du fichier" également où le format est uniquement la date, pas d'heure incluse, JJ/MMM/AAAA ?
Peu importe où je cherche, je n'arrive pas à modifier votre code pour le faire correctement moi-même.

Je vous remercie à l'avance!

rayon
Ce commentaire a été minimisé par le modérateur sur le site
oh je vois, c'est tout le code. J'ai essayé d'ajouter à l'original et j'obtenais une erreur. Merci!
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour.

Existe-t-il un moyen d'ajouter également le numéro de page des documents et j'obtiens également une erreur et voici le message :
xStr = Espace(LOF(xFileNum))


Merci beaucoup.
Ce commentaire a été minimisé par le modérateur sur le site
Génial code ! Je n'arrive pas à le faire fonctionner dans les sous-dossiers. Quelqu'un peut-il m'aider s'il vous plaît?
Ce commentaire a été minimisé par le modérateur sur le site
voce conseguiu achar uma maneira de funcionar em subpastas ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Flavie,
Pour obtenir le nombre de tous les fichiers PDF du dossier et des sous-dossiers, veuillez appliquer le code ci-dessous :

Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub


S'il vous plaît essayez, j'espère que cela peut vous aider!
Ce commentaire a été minimisé par le modérateur sur le site
Fonction Sim ! muito obrigado

Tous les documents .pdf envoient des analyses avec 0 pages incorretamente. Saberia me dizer o porque?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Flavie,
Vous pouvez télécharger votre fichier PDF ici, afin que nous puissions vérifier le problème.
Merci !
Ce commentaire a été minimisé par le modérateur sur le site
Opa, super top, consegue adicionar para aparecer o tamanho do arquivo, na terceira coluna ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, SrdosPDF
Le code VBA suivant peut vous rendre service, veuillez l'essayer :
Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
xRg.Offset(0, 2) = "Size(b)"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
Cells(I, 3) = FileLen(xFdItem & xFileName)
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub

J'espère que cela pourra vous aider !
Ce commentaire a été minimisé par le modérateur sur le site
Merci beaucoup
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, fonctionne très bien, merci pour ce partage. Une question, est-il possible d'ajouter que cela compte également les fichiers Microsoft Word .doc et .docx ?
Ce commentaire a été minimisé par le modérateur sur le site
Salut, sroczeto,
Pour compter le nombre de pages des .doc et .docx ainsi que les fichiers PDF, veuillez appliquer le code suivant :
Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xWdApp
Dim xWd
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
Application.ScreenUpdating = Faux
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Si fin
Application.ScreenUpdating = True
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Merci mon pote! Cela fonctionne sur pdf et docx, mais pas sur les fichiers doc. Et une question de plus, pouvez-vous ajouter que cela comptera également dans les sous-dossiers ?
Ce commentaire a été minimisé par le modérateur sur le site
J'ai ouvert un fichier pdf dont le chemin et le nom sont mentionnés dans la colonne de cellule Excel "C9". Je veux juste obtenir le dernier numéro de page dans Excel vba s'il vous plaît aidez-moi
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, cela fonctionne très bien, merci. Est-il possible d'obtenir la taille de page de la première page dans une nouvelle colonne ? exemple 8.5 x 11, 11 x 17 etc.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, cela fonctionne très bien merci !, est-il possible d'obtenir la taille de la page pour la première page du document PDF ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
Est-il possible d'obtenir également les dimensions des pages et le créateur du pdf dans cette macro ?
Quelqu'un peut il m'aider avec ça?
Ce commentaire a été minimisé par le modérateur sur le site
y a-t-il un moyen d'inclure .doc J'ai remarqué que cela fonctionne pour .docx mais pas .doc
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour John, Pour compter les pages de .doc et .docx ainsi que les fichiers PDF, veuillez appliquer le code suivant : Sous PageStatistiques()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xWdApp
Dim xWd
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
Application.ScreenUpdating = Faux
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
xNomFichier = Dir(xFdItem & "*.doc", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Si fin
Application.ScreenUpdating = True
End SubVeuillez essayer, j'espère que cela pourra vous aider !
Ce commentaire a été minimisé par le modérateur sur le site
Merci cela aide beaucoup.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, j'ai un dossier avec plusieurs sous-dossiers Comment puis-je spécifier le chemin du dossier parent sans le sélectionner manuellement. Ensuite, la sortie indique également le nom du dossier enfant. Merci d'avance 
Ce commentaire a été minimisé par le modérateur sur le site
HI trié j'ai édité le code supprimé XFD et défini filpath comme xfditem
Ce commentaire a été minimisé par le modérateur sur le site
Salut Skyyang, Tout d'abord je voudrais te remercier pour ce travail incroyable que tu fais, et le temps que tu prends... Je cherche depuis un moment un code VBA : J'ai une feuille Excel avec en colonne "J" une liste des fichiers pdf, xlsx et elm situés dans un répertoire de data room (avec des sous-répertoires) Le nom du fichier est complet avec le type X:\Data_Room\Sub_directory_1\file.pdfLe code doit remplir la colonne "I" avec le nombre de pages de chaque .pdf et .xls (pas besoin d'autres, les cellulos doivent rester vides) Pourriez-vous m'aider s'il vous plaît ?
Ce commentaire a été minimisé par le modérateur sur le site
Y a-t-il une chance que cela puisse être étendu pour extraire un numéro Bates de la première page de chaque pdf ?
Il n'y a pas encore de commentaires postés ici
TÉLÉCHARGER PLUS
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés

Nous suivre

Copyright © 2009 - www.extendoffice.com. | Tous les droits sont réservés. Alimenté par ExtendOffice. | | Plan du site
Microsoft et le logo Office sont des marques commerciales ou des marques déposées de Microsoft Corporation aux États-Unis et / ou dans d'autres pays.
Protégé par Sectigo SSL