Signaler

Mise en forme d'une impression de tableau [Résolu]

Posez votre question TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - Dernière réponse le 12 sept. 2017 à 11:20 par f894009
Bonjour,

J'imprime une liste issue d'une feuille, sous forme de tableau et je me suis servi des macro automatiques pour que mon tableau soit d'un style voulu.
Le problème est que cette macro automatique me donne un nombre de lignes fixe pour la mise en forme, alors que la liste évolue.

Sub CreerListeInscrits()
    On Error Resume Next
    Dim shListInscrits, shNames
    
    'Localise la feuille 'Liste_Adherents' sheet
    Set shListInscrits = Sheets("Liste_Adherents")
    If Err.Number = 9 Then 'Si pas trouvée
        Set shListInscrits = Sheets.Add(after:=Sheets(Sheets.Count))    'crée la feuille
        shListInscrits.Name = "Liste_Adherents"
    Else
        MsgBox "La feuille 'Liste_Adherents' existe déjà. Supprimez la et relancez la macro.", vbExclamation, "macro CreerListeInscrits"
        Exit Sub
    End If
    
    If vbNo = MsgBox("La macro va créer la liste des adhérents. Cela prendra plusieurs secondes : " & vbCrLf & _
                     "attendez le message de fin avant de continuer à travailler avec Excel. " & vbCrLf & _
                     "Continuer ?", vbYesNo Or vbQuestion, "macro CreerListeInscrits") Then Exit Sub
    
    'Build the header line
    With shListInscrits.Range("A1")
        .Value = "N°"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 4
    End With
    
    With shListInscrits.Range("B1")
        .Range("A1").Value = "Nom"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 10
    End With
    
    With shListInscrits.Range("C1")
        .Value = "Prénom"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 8
    End With
    
    With shListInscrits.Range("D1")
        .Value = "Né le"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 8
    End With
    
    With shListInscrits.Range("E1")
        .Value = "Mail"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 17
    End With
    
    With shListInscrits.Range("F1")
        .Value = "Tel.F"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 9
    End With
    
    With shListInscrits.Range("G1")
        .Value = "Tel.M"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 9
    End With
    
    With shListInscrits.Range("H1")
        .Value = "Adresse"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 15
    End With
    
    With shListInscrits.Range("I1")
        .Value = "CP"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 5
    End With
    
    With shListInscrits.Range("J1")
        .Value = "Ville"
        .Font.Size = 8
        .Font.Bold = True
        .ColumnWidth = 17
    End With
    
    With shListInscrits.Range("K1")
        .Value = "Code1"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 1
    End With
    
    With shListInscrits.Range("L1")
        .Value = "Code2"
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 1
    End With
    
    With shListInscrits.Range("M1")
        .Value = "Code3"
        .Font.Size = 8
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 1
    End With
    
    With shListInscrits.Range("N1")
        .Value = "D. Ins."
        .Font.Size = 8
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .ColumnWidth = 6
    End With
    
    shListInscrits.Columns("D:D").NumberFormat = "dd/MM/yyyy"
    shListInscrits.Columns("N:N").NumberFormat = "dd/MM/yyyy"
    
        
    Set shNames = Sheets("INSCRIPTIONS_17-18")
    Dim iRowSrc%, iRowDst%, iNumRawDst%
    iRowDst = 2
    For iRowSrc = 2 To Application.WorksheetFunction.CountA(shNames.Range("A:A")) + 1 'c
        If shNames.Cells(iRowSrc, 1) > 0 Then
            shListInscrits.Range("A" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("A" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("A" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!E" & iRowSrc  'numéro
            shListInscrits.Range("B" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("B" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!A" & iRowSrc  'nom
            shListInscrits.Range("C" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("C" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!B" & iRowSrc  'prenom
            shListInscrits.Range("D" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("D" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!F" & iRowSrc  'naisance
            shListInscrits.Range("E" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("E" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!G" & iRowSrc  'Mail
            
            shListInscrits.Range("F" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("F" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("F" & iRowDst).NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
            shListInscrits.Range("F" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!H" & iRowSrc  'Tel.F
                If shListInscrits.Range("F" & iRowDst).Value = 0 Then shListInscrits.Range("F" & iRowDst).Value = " " 'Tel.F
            
            shListInscrits.Range("G" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("G" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("G" & iRowDst).NumberFormat = "0#"" ""##"" ""##"" ""##"" ""##"
            shListInscrits.Range("G" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!I" & iRowSrc   'Tel.M
                If shListInscrits.Range("G" & iRowDst).Value = 0 Then shListInscrits.Range("G" & iRowDst).Value = " " 'Tel.M
                
            shListInscrits.Range("H" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("H" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!K" & iRowSrc 'Adresse
            shListInscrits.Range("I" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("I" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("I" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!L" & iRowSrc 'CP
            shListInscrits.Range("J" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("J" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!M" & iRowSrc 'Ville
            
            shListInscrits.Range("K" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("K" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("K" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!N" & iRowSrc 'Code1
                If shListInscrits.Range("K" & iRowDst).Value = 0 Then shListInscrits.Range("K" & iRowDst).Value = " "
               
            shListInscrits.Range("L" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("L" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("L" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!O" & iRowSrc 'Code2
                If shListInscrits.Range("L" & iRowDst).Value = 0 Then shListInscrits.Range("L" & iRowDst).Value = " "
                
            shListInscrits.Range("M" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("M" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("M" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!P" & iRowSrc 'Code3
            If shListInscrits.Range("M" & iRowDst).Value = 0 Then shListInscrits.Range("M" & iRowDst).Value = " "
            
            shListInscrits.Range("N" & iRowDst).Font.Size = 6   '
            shListInscrits.Range("N" & iRowDst).HorizontalAlignment = xlCenter
            shListInscrits.Range("N" & iRowDst).Formula = "='INSCRIPTIONS_17-18'!T" & iRowSrc 'D.Ins.
                
            shListInscrits.Range("A" & iRowDst).RowHeight = 12
           
            iRowDst = iRowDst + 1
        End If
    Next
    
    'Trie la liste
    Selection.Sort Key1:=shListInscrits.Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    shListInscrits.Activate
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
          
    ActiveWindow.FreezePanes = True


PARTI FAITE A L'AIDE DES MACRO AUTO

 
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$N$150"), , xlYes).Name = "Tableau4"
    Range("Tableau4[#All]").Select
    ActiveSheet.ListObjects("Tableau4").TableStyle = "TableStyleLight1"
    Range("A2").Select


SUITE DU CODE

iNumRawDst = Application.WorksheetFunction.CountA(shListNo.Range("A:A"))
    
    With shListInscrits.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&08 Liste des adhérents par noms au &D à &T"
        .RightHeader = ""
        .LeftFooter = ""
        .RightFooter = ""
        .CenterFooter = "&08 Page &P de &N"
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .HeaderMargin = Application.CentimetersToPoints(1)   '
        .FooterMargin = Application.CentimetersToPoints(1)   '
        .TopMargin = Application.CentimetersToPoints(1.5)    '
        .BottomMargin = Application.CentimetersToPoints(1.5) '
        .RightMargin = Application.CentimetersToPoints(1)    '
        .LeftMargin = Application.CentimetersToPoints(1)     '
    End With

    Sheets("TABLEAU_DE_BORD").Select
    Cells(4, 29).Value = 1
    Cells(4, 32).Font.Size = 12
    Cells(4, 32).Font.Bold = True
    Cells(4, 32).Value = "  Liste créée le " & Date & " à " & Time
    Cells(1, 1).Select
    Cells(1, 1).Activate
    Sheets("Liste_Adherents").Select
    If vbNo = MsgBox("Liste correctement créée. " & iNumRawDst - 1 & " noms ajoutés." & vbCrLf & "La feuille est concue pour " & _
           "être imprimée sur du papier A4 en mode paysage. Voulez-vous l'imprimer ?", vbYesNo Or vbQuestion, "macro CreerListeInscrits") Then Exit Sub Else ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
End Sub


Quelqu'un peut-il me dire comment faire pour que cette mise en forme s'applique à la totalité du tableau quelque soit sa longueur.
Je précise que je ne suis pas très doué pour le VBA que je comprend vite mais qu'il faut parfois m'expliquer longtemps.
Merci d'avance
Utile
+0
plus moins
Bonjour,

'PARTI FAITE A L'AIDE DES MACRO AUTO
    'derniere ligne du tableau
    derlig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$N$" & derlig), , xlYes).Name = "Tableau4"
    Range("Tableau4[#All]").Select
    ActiveSheet.ListObjects("Tableau4").TableStyle = "TableStyleLight1"
    Range("A2").Select
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 12 sept. 2017 à 08:48
Bonjour,
Merci, mais ...
Ca ne fonctionne pas, le tableau est créé mais la mise en forme ne se fait pas.
Répondre
f894009 12129Messages postés dimanche 25 novembre 2007Date d'inscription 21 septembre 2017 Dernière intervention - 12 sept. 2017 à 11:20
Re,
Chez moi ca marche

fait avec votre fichier: https://mon-partage.fr/f/8tIdU4dc/
Répondre
Donnez votre avis

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !