Discussion :

[M. De la Guigne]

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

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

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
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

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

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.

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?

[M. De la Guigne]

En continuant à y réfléchir et en cherchant :

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub Lancement()
 
    Dim c As Range
 
    Dim EventsName As String
 
Dim Rep As String
 
 
 
Dim ws As Worksheet
 
 
 
 
 
 
 
 
 
    Application.ScreenUpdating = False
 
 
 
    Set c = Worksheets("Sommaire").Range("A1")
 
    Do Until IsEmpty(c)
 
 
 
        With Worksheets(ThisWorkbook.Sheets.Count) '
 
            Sheets("Variable").Range("C1") = c.Value
 
 
 
            Worksheets("Reporting").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 
ThisWorkbook.Path & "\" & "Reporting" & " " & Worksheets("Variable").Range("C1") & ".pdf", Quality:= _
 
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
 
From:=1, To:=20, OpenAfterPublish:=False
 
Application.DisplayAlerts = False
 
 
 
 
 
        End With
 
 
 
        Set c = c.Offset(1, 0)
 
    Loop
 
 
 
    Application.ScreenUpdating = True
 
End Sub