Contenu de l'entête variable en fonction de la pagination

Bonjour,

Dans le document ci-joint, la pagination sépare chaque pays sur une page. A l'impression on masque la colonne pays qui serait trop redondante. L'idée est donc (à l'aide d'une macro) de récupérer le pays correspondant à la page en cours et de l'afficher dans l'entête.

14exemple.xlsx (10.57 Ko)

Si en plus on peut avoir la main sur la taille du texte affiché ce serait parfait.

Merci pour votre aide.

Bonjour

Un autre solution : garder la colonne mais masquer les répétitions par MFC

Bonjour Obd, Chris, bonjour le forum,

Une macro qui triche et crée un onglet par pays à la volée, l'imprime, puis à la fin supprime le dernier onglet :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim NO As Worksheet 'déclare la variable NO (Nouvel Onglet)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet vierge à la fin
Set NO = ActiveSheet 'définit le nouvel onglet NO
NO.Range("A1").Value = "Nom" 'écrit en A1 du nouvel onglet
NO.Range("B1").Value = "Promotion" 'écrit en B1 du nouvel onglet
NO.Range("C1").Value = "Période" 'écrit en C1 du nouvel onglet
NO.Columns(1).ColumnWidth = 16.57 'largeur de la colonne A du nouvel onglet
NO.Columns(2).ColumnWidth = 10.71 'largeur de la colonne B du nouvel onglet
NO.Columns(3).ColumnWidth = 10.71 'largeur de la colonne C du nouvel onglet
NO.Columns(4).ColumnWidth = 17.86 'largeur de la colonne D du nouvel onglet
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire avec les données en colonne 1 de TV
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
    K = 1 'initialise la variable K
    NO.Name = TMP(J) 'renomme l'onglet NO
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition 'si la donnée ligne I colonne 1 de TV est égale à l'élément TMP(J) de la boucle 1
            ReDim Preserve TL(1 To 4, 1 To K) 'redimensionne le tableau des lignes TL (4 lignes, K colonnes)
            TL(1, K) = TV(I, 2) 'récupère la la ligne 1 de TL la donnée en colonne 2 de TV (=> Transposition)
            TL(2, K) = TV(I, 3) 'récupère la la ligne 2 de TL la donnée en colonne 3 de TV (=> Transposition)
            TL(3, K) = TV(I, 4) 'récupère la la ligne 3 de TL la donnée en colonne 4 de TV (=> Transposition)
            TL(4, K) = TV(I, 5) 'récupère la la ligne 4 de TL la donnée en colonne 5 de TV (=> Transposition)
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    'renvoie dans A2 redimensionnée de l'onglet NO le tableau TL transposé
    NO.Range("A2").Resize(UBound(TL, 2), 4).Value = Application.Transpose(TL)
    NO.PageSetup.CenterHeader = "&14&A" 'En-Tête central avec nom de l'onglet et taille de police 14
    Application.PrintCommunication = True '? je ne sais pas ce que c'est
    NO.PrintOut 'imprime l'onglet NO
    NO.Range("A1").CurrentRegion.Offset(1, 0).Delete 'efface le contenu de l'onglet ON (sauf la première ligne)
Next J 'prochain élément de la boucle 1
Application.DisplayAlerts = False 'empêche les messages d'Excel
Sheets(Sheets.Count).Delete 'supprime le dernier onglet
Application.DisplayAlerts = True 'autorise les messages d'Excel
End Sub
Rechercher des sujets similaires à "contenu entete variable fonction pagination"