You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.17 03:24:54