Microsoft 365 Essaie de supprimer les pages vierges d'un document qui a un nombre de page variable

[HAZM0G]

Bonjour je suis bloqué sur le probleme suivant :
J'ai un document word de 90 pages. Quand mon Programme se termines il peut faire parfois plus de 110 pages.
Le probleme c'es que j'essaye de supprimer les pages vierges de celui ci mais je n'y arrive pas comment faire ??

Voila le code que j'ai mis au point pour l'instant :
Dim i As Integer

' Déterminer le nombre total de pages dans le document
Dim nbPages As Integer
nbPages = worddoc.BuiltinDocumentProperties(wdPropertyPages)

' Parcourir les pages en sens inverse
For i = nbPages To 1 Step -1
' Activer la page actuelle
worddoc.Goto What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i

' Vérifier si la page est vide
If Len(Trim(wordcoc.Selection.Range.Text)) = 0 Then
' Supprimer la page si elle est vide
Pages.Range.Delete
End If
Next i



Merci d'avance

 

[mromain]

Bonjour HAZM0G et bienvenue sur le forum,

Tu trouveras ci-dessous un essai à adapter :

Sub test()
Dim l_o_rng As Word.Range
Dim l_s_pageText As String
    
    For Each l_o_rng In GetDocPages(ActiveDocument)
        'récupérer et nettoyer le texte de la page
        l_s_pageText = l_o_rng.Text
        l_s_pageText = Replace(l_s_pageText, vbCr, vbNullString)                'supprimer les retours à la ligne
        l_s_pageText = Replace(l_s_pageText, Strings.Chr(12), vbNullString)     'supprimer les saut de pages
        
        'supprimer la page s'il n'y a pas de texte
        If Trim(l_s_pageText) Like vbNullString Then l_o_rng.Delete
    Next l_o_rng
End Sub


'extrait les ranges de chaque page d'un document dans une Collection
Private Function GetDocPages(p_o_doc As Word.Document) As VBA.Collection
Dim l_l_iPage As Long
Dim l_o_collStartPages As VBA.Collection
    Set l_o_collStartPages = New VBA.Collection
    For l_l_iPage = 1 To p_o_doc.ActiveWindow.ActivePane.Pages.Count
        l_o_collStartPages.Add p_o_doc.GoTo(wdGoToPage, wdGoToAbsolute, l_l_iPage).Start
    Next l_l_iPage
    
    Set GetDocPages = New VBA.Collection
    For l_l_iPage = 2 To l_o_collStartPages.Count
        GetDocPages.Add p_o_doc.Range(l_o_collStartPages(l_l_iPage - 1), l_o_collStartPages(l_l_iPage))
    Next l_l_iPage
    GetDocPages.Add p_o_doc.Range(l_o_collStartPages(l_o_collStartPages.Count), p_o_doc.Range.End)
    Set l_o_collStartPages = Nothing
End Function

A+