Word文档页脚页码提取VBA脚本重复页码问题求助
Word页脚页码提取问题:所有页面返回相同页码值
我正在开发一款VBA脚本,用于提取Word文档所有页面的页码。该文档每页页脚处有一个表格,其中某列专门用于显示页码(格式如1/18)。但目前遇到的问题是,脚本提取时所有页面都返回相同的页码(例如第X页显示为1/18,而正确应为X/18)。
以下是我的VBA代码:
Sub CheckNumber(fichierWord As String) Dim wordApp As Object Dim wordDoc As Object Dim footer As Object Dim table As Object Dim cell As Object Dim ws As Worksheet Dim lastRow As Long Dim pageNumber As String Dim totalPages As Long Dim i As Long Dim pageText As String On Error GoTo ErrorHandler ' Initialiser Word Set wordApp = CreateObject("Word.Application") wordApp.Visible = False ' Garder Word invisible ' Ouvrir le fichier Word en lecture seule Set wordDoc = wordApp.Documents.Open(fichierWord, ReadOnly:=True) ' Obtenir le nombre total de pages totalPages = wordDoc.ComputeStatistics(2) ' 2 correspond à wdStatisticPages ' Sélectionner la feuille Excel où écrire les résultats Set ws = ThisWorkbook.Sheets("Sheet9") lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ' Boucle pour parcourir chaque page du document For i = 1 To totalPages ' Naviguer vers la page i wordApp.Selection.GoTo What:=3, Which:=1, Count:=i ' wdGoToPage = 3, wdGoToAbsolute = 1 ' Accéder au pied de page principal de la page actuelle Set footer = wordDoc.Sections(wordApp.Selection.Information(3)).Footers(1) ' wdActiveEndSectionNumber = 3 ' Vérifier s'il y a un tableau dans le pied de page If footer.Range.Tables.Count > 0 Then ' Prendre le premier tableau du pied de page Set table = footer.Range.Tables(1) ' Vérifier si la table a au moins deux lignes et plusieurs colonnes If table.Rows.Count >= 2 And table.Columns.Count >= 4 Then ' Accéder à la dernière colonne de la deuxième ligne (cellule contenant le numéro de page) Set cell = table.cell(2, 4) ' Dernière colonne (4) à la deuxième ligne (2) pageText = Trim(cell.Range.Text) ' Nettoyer le texte extrait (enlever tous les caractères inutiles) pageText = Replace(pageText, Chr(13), "") ' Supprimer le retour chariot pageText = Replace(pageText, Chr(7), "") ' Supprimer la fin de cellule pageText = Replace(pageText, "[", "") ' Supprimer les crochets, s'ils existent pageText = Replace(pageText, "]", "") pageText = Trim(pageText) ' Supprimer les espaces autour du texte ' Extraire seulement le numéro de page (avant le /) If InStr(pageText, "/") > 0 Then pageNumber = Left(pageText, InStr(pageText, "/") - 1) End If ' Formater le numéro de page avec le total des pages pageNumber = pageNumber & "/" & totalPages ' Écrire le numéro de page dans la feuille Excel ws.Cells(lastRow, 1).Value = "Page " & i ws.Cells(lastRow, 2).Value = "'" & pageNumber ' Préserver le format texte pour éviter la conversion en date lastRow = lastRow + 1 Else ws.Cells(lastRow, 1).Value = "Page " & i ws.Cells(lastRow, 2).Value = "Tableau non conforme" lastRow = lastRow + 1 End If Else ws.Cells(lastRow, 1).Value = "Page " & i ws.Cells(lastRow, 2).Value = "Aucun tableau trouvé" lastRow = lastRow + 1 End If Next i ' Fermer le document Word wordDoc.Close False wordApp.Quit Set wordApp = Nothing Exit Sub ErrorHandler: MsgBox "Erreur lors de l'ouverture ou de la lecture du fichier Word: " & Err.Description, vbCritical If Not wordApp Is Nothing Then wordApp.Quit End If End Sub
该代码旨在自动提取Word文档页脚的页码并存储到Excel工作表中,目标是准确收集所有页面的页码并按顺序记录。
内容的提问来源于stack exchange,提问作者AMINE OUKESSOU
相关产品推荐
相关产品推荐

