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

Jak spočítat čísla stránek souborů PDF v aplikaci Excel?

Pokud existuje více souborů Pdf v konkrétní složce, nyní chcete zobrazit všechny tyto názvy souborů v listu a získat čísla stránek každého souboru. Jak byste mohli tuto práci v aplikaci Excel zvládnout rychle a snadno?

Počítat čísla stránek souborů PDF ze složky v listu s kódem VBA


Počítat čísla stránek souborů PDF ze složky v listu s kódem VBA

Může to být následující kód VBA, který vám pomůže zobrazit v listu všechny názvy souborů PDF a jejich jednotlivá čísla stránek, postupujte takto:

1. Otevřete list, kde chcete získat soubory PDF a čísla stránek.

2. Podržte ALT + F11 klíče a otevře se Microsoft Visual Basic pro aplikace okno.

3, klikněte Vložit > Modula vložte následující makro do souboru Modul Okno.

Kód VBA: Seznam všech názvů souborů PDF a čísel stránek v listu:

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. Po vložení kódu a stiskněte F5 klíč ke spuštění tohoto kódu a Procházet vyskočí okno, vyberte složku obsahující soubory Pdf, které chcete vypsat, a spočítejte čísla stránek, viz screenshot:

počet dokumentů stránky PDF 1

5. A pak klikněte OK tlačítko, všechny názvy souborů PDF a čísla stránek jsou uvedeny v aktuálním listu, viz screenshot:

počet dokumentů stránky PDF 2


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2019 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Kompletní funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50% a omezuje stovky kliknutí myší každý den!
officetab dno
Komentáře (71)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Funguje skvěle! Mnohokrát děkuji!
Tento komentář byl moderátorem webu minimalizován
Velice vám děkuji za zaslání takové informativní zprávy
Tento komentář byl moderátorem webu minimalizován
Děkuji mnohokrát, skvělý kód, který mi velmi pomohl
Tento komentář byl moderátorem webu minimalizován
Nefunguje správně, u některých souborů PDF, u některých souborů PDF ukazuje 0 a u některých nesprávná čísla stránek
Tento komentář byl moderátorem webu minimalizován
Ahoj Fawazi,
Kód funguje dobře v mém Excelu, kterou verzi Excelu používáte?
Nebo můžete poslat svůj podrobný problém nebo soubory PDF na můj e-mail: skyyang@extendoffice. Com.
Tento komentář byl moderátorem webu minimalizován
Ahoj skyyang,

Mám stejný problém jako Fawaz. Používám MS Office Professional Plus 2013.

Díky za vaši pomoc!

S pozdravem
Tento komentář byl moderátorem webu minimalizován
Totéž se děje zde, stejné stránky pdf se vrátí na nulu, laskavě to někdo vysvětlete
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Venkatesh G
Kód funguje dobře v mém Excelu, pošlete prosím své pdf soubory na můj e-mail: yy@addin99.com.
Abychom mohli zkontrolovat, kde je problém, děkujeme!
Tento komentář byl moderátorem webu minimalizován
pozdravy


Hay algún problema con el el programa, yo estoy use la la version 2019 de Office, y las pages parece que las a contando de mal las primeras 9 pages Accumuladas me sale cero, en la novena page acumulada me sale10

¿Prosím mě puedes ayudar con ese inconveniente?

Předem moc děkuji.

Atte.

Pedro
Tento komentář byl moderátorem webu minimalizován
SVATÝ! To je úžasné! Děkuji mnohokrát! Jsem tiskař a dělal jsem printit.txt a vyplňoval jsem ručně! Díky tomu bude citování a kontrola zakázek MNOHEM SNADNĚJŠÍ! Ještě jednou děkuji!!!
Tento komentář byl moderátorem webu minimalizován
Pozdravy

Vyskytl se problém s programem, používám verzi Office 2019 a stránky se mi špatně počítají. Prvních 9 nashromážděných stránek mám nulu, na deváté nashromážděné stránce 10.

Můžete mi prosím pomoci s touto nepříjemností?

Předem moc děkuji.

Atte.

Pedro
Tento komentář byl moderátorem webu minimalizován
Kód je dobrá struktura pro to, jak dělat takové věci, ale tento regexp dá nespolehlivé výsledky pro mnoho souborů PDF. Hledaný regulární výraz (/Typ\s*/Stránka[^s]) nebude fungovat v ZABEZPEČENÝCH pdf (počet bude nula). Nástroje a verze souborů PDF se také liší v tom, jak stránky označují. Mohlo by to být přesné, pokud víte, že všechny vaše soubory PDF jsou vytvořeny pomocí stejné struktury (verze a nástrojů).
Tento komentář byl moderátorem webu minimalizován
Děkuji mnohokrát za odpověď, problém jsem vyřešil uložením souborů jako: "Optimalizované PDF"
Tento komentář byl moderátorem webu minimalizován
100% souhlasím s Pedrem, měl jsem stejný problém jako Rob, kde byly některé počty stránek PDF špatné. Ale pokud se ujistíte, že všechny soubory jsou ve složce uloženy jako "Optimalizované PDF", budou všechny stránky správné. To mi fungovalo na více než 100 samostatných souborech PDF. S aplikací Acrobat Pro můžete také hromadně optimalizovat. Celkově skvělý kód, fungoval hned po vybalení, chcete-li.
Tento komentář byl moderátorem webu minimalizován
Co když chci také procházet podsložky?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Prashante,
Chcete-li získat počet všech souborů PDF ze složky a podsložek, použijte níže uvedený kód:

Sub Test ()
Dim I As Long
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFdItem jako varianta
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Pokud xFd.Show = -1 Pak
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Nastavit xRg = Range("A1")
Rozsah("A:B").Vymazat obsah
Rozsah("A1:B1").Font.Tučné = True
xRg = "Název souboru"
xRg.Offset(0, 1) = "Stránky"
I = 2 XNUMX
Zavolejte SunTest (xFdItem, I)
End If
End Sub

Sub SunTest (xFdItem As Variant, I As Long)
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Dim xF jako objekt
Dim xSF jako objekt
Dim xFso jako objekt
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
Nastavit RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Typ\s*/Stránka[^s]"
xFileNum = FreeFile
Otevřít (xFdItem & xFileName) pro binární jako #xFileNum
xStr = mezera(LOF(xFileNum))
Získejte #xFileNum, , xStr
Zavřete #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Smyčka
Columns("A:B").Automatické přizpůsobení
Set xFso = CreateObject("Scripting.FileSystemObject")
Nastavit xF = xFso.GetFolder(xFdItem)
Pro každý xSF v xF.SubFolders
Zavolejte SunTest(xSF.Path & "\", I)
další
End Sub

Zkuste to prosím, doufám, že vám to pomůže!
Tento komentář byl moderátorem webu minimalizován
Váš kód podsložky funguje dobře! dík
Tento komentář byl moderátorem webu minimalizován
To je úžasné, děkuji. Rád bych také prošel podsložky. Kde/jak do výše uvedeného kódu přidám tyto další příkazy? jak by to celé vypadalo?
Tento komentář byl moderátorem webu minimalizován
Můžete mi pomoci získat také tvůrce a rozměry souboru?
Tento komentář byl moderátorem webu minimalizován
Je to opravdu skvělé. Názvy podsložek však nepřicházejí do samostatného sloupce s názvy souborů PDF a počtem stránek. můžete v tom pomoci?
Tento komentář byl moderátorem webu minimalizován
Fantastický!!!
Tento komentář byl moderátorem webu minimalizován
Děkuju mnohokrát.
Tento komentář byl moderátorem webu minimalizován
Ahoj,
Nemáš zač. Jsem rád, že to pomáhá. V případě jakýchkoli dotazů nás neváhejte kontaktovat. Přeji krásný den.
S pozdravem,
Mandy
Tento komentář byl moderátorem webu minimalizován
Ahoj Mandy,
Zobrazuje se mi chyba při běhu '5': Neplatné volání procedury nebo argument
Ladění jde na tento řádek: xStr = Space(LOF(xFileNum))
Tento komentář byl moderátorem webu minimalizován
Běžím, ale zobrazí se chyba a ladění zobrazuje jako problém xStr = Space(LOF(xFileNum)).
Tento komentář byl moderátorem webu minimalizován
Díky moc.
Stejně tak umíte počítat a kategorizovat stránky A3 a A4?
Tento komentář byl moderátorem webu minimalizován
Zde je kód, který jsem našel někde na netu, není tak optimální jako vaše metoda:
Možnost explicitní
Veřejný PDFDoc jako AcroPDDoc, PDFPage jako objekt, A3&, A4&

Sub Main ()
Dim fso As FileSystemObject, fld As Folder, fil As File, s$, i&, Arr()
Nastavit fso = New FileSystemObject
Nastavit PDFDoc = Nový AcroPDDoc
Nastavit fld = fso.GetFolder(ThisWorkbook.Path)
ReDim Arr (1 až 1000, 1 až 3)
Pro každý fil In fld.Files
s = fil.Jméno
If Right(s, 4) = ".pdf" Then
CountPagesPDF (ThisWorkbook.Path & "\" & s)
i = i + 1
Arr(i, 1) = s
Arr(i, 2) = A3
Arr(i, 3) = A4
End If
další
Rozsah("A2:C" & Cells.Rows.Count).Vymazat
Rozsah("A2:C" & (i + 1)) = Arr
Nastavit PDFPage = nic
Nastavit PDFDoc = Nic
Nastavit fso = nic
End Sub

Sub CountPagesPDF(FullFileName$)
Dim i&, n&, x, y
A3 = 0
A4 = 0
PDFDoc.Open (FullFileName)
n = PDFDoc.GetNumPages
Pro i = 0 až n - 1
Nastavit PDFPage = PDFDoc.AcquirePage(i)
x = PDFPage.GetSize().x
y = PDFPage.GetSize().y
Pokud x + y > 1500, pak A3 = A3 + 1 Jinak A4 = A4 + 1
další
PDFDoc.Zavřít
End Sub
Tento komentář byl moderátorem webu minimalizován
Wov! moc děkujeme za sdílení, tento kód VBA je zabiják!! S Excelem O365 funguje bezchybně
Tento komentář byl moderátorem webu minimalizován
Páni. podsložky fungují skvěle. můžete se podělit o to, jak přidat také "cestu k souboru" a "velikost souboru"?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Daphne,
Chcete-li vyřešit svůj problém, použijte níže uvedený kód, zkuste to, doufám, že vám může pomoci!

Sub Test ()
Dim I As Long
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFdItem jako varianta
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Pokud xFd.Show = -1 Pak
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Nastavit xRg = Range("A1")
Rozsah("A:B").Vymazat obsah
Rozsah("A1:B1").Font.Tučné = True
xRg = "Název souboru"
xRg.Offset(0, 1) = "Stránky"
xRg.Offset(0, 2) = "Cesta"
xRg.Offset(0, 3) = "Velikost(b)"
I = 2 XNUMX
Zavolejte SunTest (xFdItem, I)
End If
End Sub

Sub SunTest (xFdItem As Variant, I As Long)
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Dim xF jako objekt
Dim xSF jako objekt
Dim xFso jako objekt
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
Nastavit RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Typ\s*/Stránka[^s]"
xFileNum = FreeFile
Otevřít (xFdItem & xFileName) pro binární jako #xFileNum
xStr = mezera(LOF(xFileNum))
Získejte #xFileNum, , xStr
Zavřete #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
Cells(I, 3) = xFdItem & xFileName
Cells(I, 4) = FileLen(xFdItem & xFileName)
I = I + 1
xFileName = Dir
Smyčka
Columns("A:B").Automatické přizpůsobení
Set xFso = CreateObject("Scripting.FileSystemObject")
Nastavit xF = xFso.GetFolder(xFdItem)
Pro každý xSF v xF.SubFolders
Zavolejte SunTest(xSF.Path & "\", I)
další
End Sub
Tento komentář byl moderátorem webu minimalizován
To je skvělé. Dík!
Tento komentář byl moderátorem webu minimalizován
Ahoj skyyang,
Omlouvám se, že jsem narazil na starý příspěvek.
Děkuji za výše uvedený kód, moc mi pomáhá!
Chtěli byste se podělit o to, jak přidat „datum vytvoření souboru“ také tam, kde je formát pouze datum, bez času, DD/MMM/RRRR?
Bez ohledu na to, kde hledám, nedokážu upravit váš kód, abych to udělal správně.

Děkuji předem!

Paprsek
Tento komentář byl moderátorem webu minimalizován
aha, tohle je celý kód. Zkoušel jsem přidat do originálu a vyskytla se chyba. Děkuji!
Tento komentář byl moderátorem webu minimalizován
Ahoj.

Existuje způsob, jak přidat také číslo stránky dokumentů a také se mi zobrazí chyba a toto je zpráva:
xStr = mezera(LOF(xFileNum))


Děkuju mnohokrát.
Tento komentář byl moderátorem webu minimalizován
Úžasný kód! Nemohu to zprovoznit v podsložkách. Pomůže mi někdo prosím?
Tento komentář byl moderátorem webu minimalizován
voce conseguiu achar uma maneira de funcionar em subpastas?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Flavio,
Chcete-li získat počet všech souborů PDF ze složky a podsložek, použijte níže uvedený kód:

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


Zkuste to prosím, doufám, že vám to pomůže!
Tento komentář byl moderátorem webu minimalizován
Sim funguje! muito obrigado

Dokumenty Alguns .pdf jsou odeslány analýzy s 0 nesprávnými stránkami. Saberia me dizer nebo porque?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Flavio,
Zde můžete nahrát svůj soubor PDF, abychom mohli problém zkontrolovat.
Děkuji!
Tento komentář byl moderátorem webu minimalizován
Opa, super top, consegue adicionar para aparecer o tamanho do arquivo, na terceira coluna ?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, SrdosPDF
Následující kód VBA vám může udělat laskavost, zkuste to:
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

Doufám, že vám to může pomoci!
Tento komentář byl moderátorem webu minimalizován
Děkuji moc
Tento komentář byl moderátorem webu minimalizován
Dobrý den, funguje to skvěle, děkujeme za sdílení. Jedna otázka, je možné dodat, že to počítá i soubory .doc a .docx microsoft word?
Tento komentář byl moderátorem webu minimalizován
Ahoj sroczeto,
Chcete-li spočítat číslo stránek .doc a .docx a také souborů PDF, použijte následující kód:
Sub Test ()
Dim I As Long
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFdItem jako varianta
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Ztlumit xWdApp
Rozměr xWd
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Pokud xFd.Show = -1 Pak
Application.ScreenUpdating = False
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
Nastavit xRg = Range("A1")
Rozsah("A:B").Vymazat obsah
Rozsah("A1:B1").Font.Tučné = True
xRg = "Název souboru"
xRg.Offset(0, 1) = "Stránky"
I = 2 XNUMX
xStr = ""
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
Nastavit RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Typ\s*/Stránka[^s]"
xFileNum = FreeFile
Otevřít (xFdItem & xFileName) pro binární jako #xFileNum
xStr = mezera(LOF(xFileNum))
Získejte #xFileNum, , xStr
Zavřete #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Smyčka
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Nastavit xWdApp = CreateObject("Word.Application")
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
xFileNum = FreeFile
Nastavit xWd = GetObject(xFdItem & xFileName)
Cells(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
I = I + 1
xFileName = Dir
Smyčka
Columns("A:B").Automatické přizpůsobení
End If
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Díky kámo! Funguje na pdf a docx, ale ne na souborech doc. A ještě jedna otázka, můžete přidat, že se to bude počítat i do podsložek?
Tento komentář byl moderátorem webu minimalizován
Otevřel jsem soubor pdf, jehož cesta a jméno jsou uvedeny ve sloupci buňky Excel "C9". Chci jen získat číslo poslední stránky v aplikaci Excel vba, prosím, pomozte mi
Tento komentář byl moderátorem webu minimalizován
Dobrý den, opravdu to funguje, děkuji. Je možné získat velikost stránky první stránky v novém sloupci? příklad 8.5 x 11, 11 x 17 atd.
Tento komentář byl moderátorem webu minimalizován
Dobrý den, toto funguje opravdu dobře díky!, je možné získat velikost stránky pro první stránku dokumentu PDF?
Tento komentář byl moderátorem webu minimalizován
Ahoj,
Je možné v tomto makru získat také rozměry stránek a tvůrce pdf?
může mi s tím někdo pomoci?
Tento komentář byl moderátorem webu minimalizován
existuje způsob, jak zahrnout .doc Všiml jsem si, že to funguje pro .docx, ale ne pro .doc
Tento komentář byl moderátorem webu minimalizován
Ahoj, Johne, Chcete-li počítat stránky .doc a .docx a také soubory PDF, použijte prosím následující kód: Dílčí stránka statistik()
Dim I As Long
Dim xRg jako rozsah
Dim xStr jako řetězec
Dim xFd As FileDialog
Dim xFdItem jako varianta
Dim xFileName jako řetězec
Dim xFileNum as Long
Ztlumit RegExp jako objekt
Ztlumit xWdApp
Rozměr xWd
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Pokud xFd.Show = -1 Pak
Application.ScreenUpdating = False
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
Nastavit xRg = Range("A1")
Rozsah("A:B").Vymazat obsah
Rozsah("A1:B1").Font.Tučné = True
xRg = "Název souboru"
xRg.Offset(0, 1) = "Stránky"
I = 2 XNUMX
xStr = ""
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
Nastavit RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Typ\s*/Stránka[^s]"
xFileNum = FreeFile
Otevřít (xFdItem & xFileName) pro binární jako #xFileNum
xStr = mezera(LOF(xFileNum))
Získejte #xFileNum, , xStr
Zavřete #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Smyčka
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Nastavit xWdApp = CreateObject("Word.Application")
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
xFileNum = FreeFile
Nastavit xWd = GetObject(xFdItem & xFileName)
Cells(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
I = I + 1
xFileName = Dir
Smyčka
xFileName = Dir(xFdItem & "*.doc", vbDirectory)
Nastavit xWdApp = CreateObject("Word.Application")
Proveďte při xFileName <> ""
Cells(I, 1) = xFileName
xFileNum = FreeFile
Nastavit xWd = GetObject(xFdItem & xFileName)
Cells(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
I = I + 1
xFileName = Dir
Smyčka
Columns("A:B").Automatické přizpůsobení
End If
Application.ScreenUpdating = True
End SubProsím, zkuste to, doufám, že vám to pomůže!
Tento komentář byl moderátorem webu minimalizován
Díky tohle hodně pomáhá.
Tento komentář byl moderátorem webu minimalizován
Ahoj, mám složku s více podsložkami Jak mohu zadat cestu k nadřazené složce, aniž bych ji ručně vybral. Potom také výstup název podřízené složky. Díky předem 
Tento komentář byl moderátorem webu minimalizován
HI seřazeno, upravil jsem kód odstraněný XFD a nastavil filpath jako xfditem
Tento komentář byl moderátorem webu minimalizován
Ahoj Skyyang, nejprve bych ti rád poděkoval za neuvěřitelnou práci, kterou odvádíš, a za čas, který věnuješ... chvíli hledám kód VBA: Mám list Excel se seznamem ve sloupci „J“ souborů pdf, xlsx a elm umístěných v adresáři datové místnosti (s podadresářem) Název souboru je kompletní s typem X:\Data_Room\Sub_directory_1\file.pdf Kód by měl vyplnit sloupec "I" počtem stránek každého .pdf a .xls soubory (není třeba dalších, cels by měly zůstat prázdné) Mohli byste mi prosím pomoci?
Tento komentář byl moderátorem webu minimalizován
Je nějaká šance, že by se to dalo rozšířit tak, aby vytáhlo Batesovo číslo z první stránky každého pdf?
Zatím zde nejsou žádné komentáře
Načíst další
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění