Reproduire les sauts de page

 

  • L’utilisateur indique le nom de la feuille ‘modèle’
  • L’utilisateur indique le nom de la feuille ‘cible’
  • La macro fait le reste…
Sub DuplicatePageBreaks()
'------------------------------------------------------------------------------------------------
'Macro de reproduction des sauts de page positionnés sur une feuille source
'-l'utilisateur indique le nom de la feuille source et de la feuille cible
'Auteur : Excellons.org
'Date : mai 2019
'------------------------------------------------------------------------------------------------
    Dim aSheetsNames As New Collection
    Dim oFromSheet As Worksheet, oToSheet As Worksheet
    Dim sFromSheetName As String, sToSheetName As String
    Dim i As Integer, iNb As Integer
    Dim oPB As HPageBreak
    Dim booOK As Boolean
    
    'On récupère les noms de feuilles du classeur dans une collection
    For Each oToSheet In ThisWorkbook.Worksheets
        aSheetsNames.Add oToSheet.Name
    Next
    
    'On vérifie qu'il existe plus d'une feuille dans le classeur, sinon on sort
    If aSheetsNames.Count = 1 Then
        MsgBox "Ce classeur ne contient qu'une seule feuille !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
        Exit Sub
    End If
    
    'On demande à l'utilisateur d'indiquer la feuille source
    sFromSheetName = InputBox("Nom de la feuille source ?", "Feuille source des sauts de page", aSheetsNames.Item(1), 2000, 1000)
    'On vérifie que l'utilisateur a indiqué un nom de feuille valide, sinon sort
    booOK = False
    For i = 1 To aSheetsNames.Count
        If sFromSheetName = aSheetsNames.Item(i) Then
            booOK = True
        End If
    Next
    If Not booOK Then
        MsgBox "Nom de feuille source non indiqué ou invalide !" & vbCrLf & vbCrLf & "Opération impossible.", vbCritical, "FIN D'OPERATION"
        Exit Sub
    End If
    
    'On référe la feuille source
    Set oFromSheet = ThisWorkbook.Worksheets(sFromSheetName)
    'On récupère le nombre de sauts de page
    iNb = oFromSheet.HPageBreaks.Count
    'S'il n'y a aucun saut de page, on sort
    If iNb = 0 Then
        MsgBox "La feuille source indiquée ne contient aucun saut de page !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
        Exit Sub
    End If

    'On demande à l'utilisateur d'indiquer la feuille cible
    sToSheetName = InputBox("Nom de la feuille cible ?", "Feuille cible sur laquelle reproduire les sauts de page", aSheetsNames.Item(2), 3000, 5000)
    'On vérifie que l'utilisateur a indiqué un nom de feuille valide, sinon sort
    booOK = False
    For i = 1 To aSheetsNames.Count
        If sToSheetName = aSheetsNames.Item(i) Then
            booOK = True
        End If
    Next
    If Not booOK Then
        MsgBox "Nom de la feuille cible non indiqué ou invalide !" & vbCrLf & vbCrLf & "Opération impossible.", vbCritical, "FIN D'OPERATION"
        Exit Sub
    End If
    
    'On réfère la feuille devant recevoir les sauts de page
    Set oToSheet = ThisWorkbook.Worksheets(sToSheetName)
    'On efface les sauts de page de la feuille cible
    oToSheet.ResetAllPageBreaks
    'On boucle sur le nombre de sauts de page
    For i = 1 To oFromSheet.HPageBreaks.Count
        'On réfère un saut de page
        Set oPB = oFromSheet.HPageBreaks(i)
        'On réplique ce saut de page dans la feuille destinataire
        oToSheet.HPageBreaks.Add oPB.Location
    Next
    MsgBox "Opération terminée avec succès !", vbExclamation, "FIN D'OPERATION"
    
    'On fait le ménage
    Set oPB = Nothing
    Set oFromSheet = Nothing
    Set oToSheet = Nothing
End Sub