Bonjour,
Je reviens avec une demande bien amusante pour un vendredi (oui chacun son sens de l'humour).
J'ai un modèle de reporting, une liste de dossier et l'objectif de pouvoir imprimer les différents reportings pour chacun de ces dossiers (il suffit que le nom du dossier soit mis dans une cellule et cela l'actualise.
Pour cela je compte utiliser différentes macros :
Pour créer un onglet par élément de la liste
Une macro pour enregistrer l'onglet en PDF
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub Création() Dim S As Object 'déclare la variable S (onglet Sommaire) Dim DL As Integer 'déclare la variable DL (Dernière Ligne) Dim TC As Variant 'déclare la variable TC (Tableau de Cellules) Dim i As Integer 'déclare la variable I (Incrément) Dim NO As Object 'déclare la variable NO (Nouvel Onglet) Set S = Sheets("sommaire") 'définit l'onglet s DL = S.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 1 (=A) de l'onglet S (à adapter) TC = S.Range("A1:A" & DL) 'définit le tableau de cellules TC (à adapter, doit correspondre à la liste...) For i = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la liogne suivante) Set NO = Sheets(TC(i, 1)) 'définit l'onglet NO (génère une erreur si cet onglet n'existe pas) If Err <> 0 Then 'condition : si une erreur a été générée Err.Clear 'supprime l'erreur Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position ActiveSheet.Name = TC(i, 1) 'renomme l'onglet ActiveSheet.Tab.ColorIndex = 6 'donne la couleur End If ' fin de la condition On Error GoTo 0 'annule la gestion des erreurs Next i 'prochaine ligne de la boucle End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36 Sub enregistrement() Dim EventsName As String Dim Rep As String Dim ws As Worksheet Application.ScreenUpdating = False On Error Resume Next EventsName = Worksheets("Sommaire").Range("b1") Rep = ThisWorkbook.Path & "\" If Dir(Rep) = "" Then MkDir (Rep) Sheets("Sommaire").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ Rep & Sheets("Sommaire").Name & " " & Worksheets("Sommaire").Range("B1") & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ From:=1, To:=20, OpenAfterPublish:=False Application.DisplayAlerts = True If MsgBox("Impression en PDF dans le dossier " & Rep & "." & Chr(10) & "Voulez vous fermer le fichier ?" _ , vbYesNo + vbInformation, "Sauvegarde réussie") = vbYes Then ThisWorkbook.Close Sheets("Sommaire").Activate End Sub
et une dernière macro pour supprimer tous les onglets mis en création (car avec un code couleur et donc épargner sommaire
L'idée est donc d'avoir un onglet qui va se créer, il s'imprime en PDF et ensuite il est supprimé et cela passe à l'élément suivant de la liste.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Sub suppression() Application.DisplayAlerts = False For Each sh In Worksheets If sh.Tab.ColorIndex = 6 Then sh.Delete Next Application.DisplayAlerts = True End Sub
Je n'arrive pas pour l'instant à marier l'idée de créer un onglet et qu'il l'enregistre.
Est-ce que déjà c'est possible?
Partager