Remplir une procédure plusieurs fois grâce à un tableau excel

**Syllox** · 11/08/2014, 16h43

Bonjour,
Je souhaite votre aide car j'ai commencé à travailler sur une version tout seul.
Mon problème : mon document ne se met à jour qu'une fois et c'est normal et s'enregistre normalement.
Cependant je voudrais saisir plusieurs fiche dans ma feuille 'info' et que cela m'enregistre plusieurs fois le documents avec les nouvelles infos.
Je cherche une solution avec une boucle mais j'ai du mal. Sachant que mon code actuel n'est pas très "clean".
Comment faire ?

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Option Explicit
Sub Macro7()
'
' Macro7 Macro
'
 
'Remplissage des colonnes'
 
    Sheets("info").Select
    Range("Lot").Select
    Selection.Copy
    Sheets("Notification").Select
    Range("F6:Y6").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("FN").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("AC6:AJ6").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("num_controle").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("H7:AJ7").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("ref").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("K8:AJ8").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("lieu").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("D11").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("date").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("U11:AE11").Select
    ActiveSheet.Paste
 
     Sheets("info").Select
    Range("heure").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("AH11").Select
    ActiveSheet.Paste
 
     Sheets("info").Select
    Range("nom").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("F12").Select
    ActiveSheet.Paste
 
     Sheets("info").Select
    Range("telephone").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("S12").Select
    ActiveSheet.Paste
 
     Sheets("info").Select
    Range("operation").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("B14").Select
    ActiveSheet.Paste
 
     Sheets("info").Select
    Range("controle").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("B17").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("nom_moet").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("D19").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("fonction_moet").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("N19").Select
    ActiveSheet.Paste
 
    Sheets("info").Select
    Range("date_moet").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Notification").Select
    Range("W19").Select
    ActiveSheet.Paste
 
    'Check Box'
    'Sheets("info").Select
   ' If ActiveSheet.Shapes.Range(Array("Point_Critique")).Value = True Then
   ' Range("F11").Select
    'ActiveCell.FormulaR1C1 = "=1"
    'End If
    If Worksheets("info").Range("N7").Value = "1" Then
    Worksheets("Notification").Range("Y15").Value = "1"
    ElseIf Worksheets("info").Range("N7").Value = "2" Then
    Worksheets("Notification").Range("Y15").Value = "2"
 
    End If
 
    'Enregistrement fichier en xls'
 
    Dim ChDir As String
    Dim NomFichier As String
    Dim NomDossier As String
    Dim NomCompletFichier As String
    Dim NomPersonne As String
    Dim Numero As String
 
    'Chemin courant'
    ChDir = Application.ActiveWorkbook.Path & "\Fiche_Notification"
 
    NomFichier = "Fiche de Notification"
    Numero = Worksheets("info").Range("B4").Value
    NomFichier = NomFichier & "_" & Numero
    'Ligne définitive :
    'NomCompletFichier = ChDir & "\" & NomFichier
 
    'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
    Dim stHeureExport As String
    stHeureExport = "_" & _
    Format(Hour(Time), "00") & "-" & Format(Minute(Time), "00") & "-" & _
    Format(Second(Time), "00")
    NomCompletFichier = ChDir & "\" & NomFichier & stHeureExport
 
    'Création Dossier si il n'est pas présent'
    NomDossier = Application.ActiveWorkbook.Path & "\Fiche_Notification"
    If Dir(NomDossier, vbDirectory) = "" Then MkDir NomDossier
 
    'Copie de la feuille courante dans un nouveau classeur et enregistrement'
    'XLS'
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=NomCompletFichier
 
    'PDF'
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomCompletFichier & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
 
    ActiveWorkbook.Close
 
    'Boite texte'
    MsgBox "Le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier & vbCrLf
 
End Sub

Merci d'avance,
Cordialement,
Pdewas

**Theze** · 11/08/2014, 17h31

Bonjour,

Pour affecter les valeurs d'une feuille à une autre, il n'est pas nécessaire de faire des collages. J'ai modifié ton code mais je ne l'ai pas tester car je n'ai pas envie de créer un classeur test avec les noms et tout le reste. Regarde le résultat et dis nous. Pour la boucle, il faudrait un peu plus de précisions :

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 Macro7()
 
    Dim Dossier As String
    Dim NomFichier As String
    Dim NomDossier As String
    Dim NomCompletFichier As String
    Dim NomPersonne As String
    Dim stHeureExport As String
 
    With Worksheets("info")
 
        Worksheets("Notification").Range("F6:Y6").Value = .Range("Lot").Value
        Worksheets("Notification").Range("AC6:AJ6").Value = .Range("FN").Value
        Worksheets("Notification").Range("H7:AJ7").Value = .Range("num_controle").Value
        Worksheets("Notification").Range("K8:AJ8").Value = .Range("ref").Value
        Worksheets("Notification").Range("D11").Value = .Range("lieu").Value
        Worksheets("Notification").Range("U11:AE11").Value = .Range("date").Value
        Worksheets("Notification").Range("AH11").Value = .Range("heure").Value
        Worksheets("Notification").Range("F12").Value = .Range("nom").Value
        Worksheets("Notification").Range("S12").Value = .Range("telephone").Value
        Worksheets("Notification").Range("B14").Value = .Range("operation").Value
        Worksheets("Notification").Range("B17").Value = .Range("controle").Value
        Worksheets("Notification").Range("D19").Value = .Range("nom_moet").Value
        Worksheets("Notification").Range("N19").Value = .Range("fonction_moet").Value
        Worksheets("Notification").Range("W19").Value = .Range("date_moet").Value
 
        Worksheets("Notification").Range("Y15").Value = .Range("N7").Value
 
        NomFichier = "Fiche de Notification_" & .Range("B4").Value
 
    End With
 
    'Chemin courant'
    Dossier = Application.ActiveWorkbook.Path & "\Fiche_Notification\"
 
    'Ligne définitive :
    'NomCompletFichier = ChDir & "\" & NomFichier
 
    'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
    stHeureExport = Format(Time, "_hh-mm-ss")
 
    NomCompletFichier = Dossier & NomFichier & stHeureExport
 
    'Création Dossier si il n'est pas présent'
    If Dir(Dossier, vbDirectory) = "" Then MkDir Dossier
 
    'Copie de la feuille courante dans un nouveau classeur et enregistrement'
    'XLS'
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=NomCompletFichier
 
    'PDF'
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomCompletFichier & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
 
    ActiveWorkbook.Close
 
    'Boite texte'
    MsgBox "Le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier & vbCrLf
 
End Sub

Hervé.

**Thautheme** · 11/08/2014, 17h33

Bonjour Syllox, bonjour le forum,

Je ne comprends pas bien comment faire une boucle. J'imagine qu'à la fin de la macro il faut effacer les données des plages nommées de l'onglet info pour te permettre de rééditer une nouvelle fiche et de relancer la macro. Mais boucler ? je vois pas comment.
En attendant ta réponse, j'ai fait un peut de nettoyage dans ton code. Il faut toujours éviter les Select inutiles qui ne font que ralentir l'exécution du code :

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
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
Sub Macro7()
Dim I As Object
Dim N As Object
Dim ChDir As String
Dim NomFichier As String
Dim NomDossier As String
Dim NomCompletFichier As String
Dim NomPersonne As String
Dim Numero As String
Dim stHeureExport As String
 
Set I = Sheets("info")
Set N = Sheets("Notification")
I.Range("Lot").Copy N.Range("F6:Y6")
I.Range("FN").Copy N.Range("AC6:AJ6")
I.Range("num_controle").Copy N.Range("H7:AJ7")
I.Range("ref").Copy N.Range("K8:AJ8")
I.Range("lieu").Copy N.Range("D11")
I.Range("date").Copy N.Range("U11:AE11")
I.Range("heure").Copy N.Range("AH11")
I.Range("nom").Copy N.Range("F12")
I.Range("telephone").Copy N.Range("S12")
I.Range("operation").Copy N.Range("B14")
I.Range("controle").Copy N.Range("B17")
I.Range("nom_moet").Copy N.Range("D19")
I.Range("fonction_moet").Copy N.Range("N19")
I.Range("date_moet").Copy N.Range("W19")
 
'Check Box'
' If I.Shapes.Range(Array("Point_Critique")).Value = True Then I.Range("F11").Value = "1"
 
If I.Range("N7").Value = "1" Then
    N.Range("Y15").Value = "1"
ElseIf I.Range("N7").Value = "2" Then
    N.Range("Y15").Value = "2"
End If
'Enregistrement fichier en xls'
 
'Chemin courant'
ChDir = Application.ActiveWorkbook.Path & "\Fiche_Notification"
 
NomFichier = "Fiche de Notification"
Numero = I.Range("B4").Value
NomFichier = NomFichier & "_" & Numero
'Ligne définitive :
'NomCompletFichier = ChDir & "\" & NomFichier
 
'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
stHeureExport = "_" & _
Format(Hour(Time), "00") & "-" & Format(Minute(Time), "00") & "-" & _
Format(Second(Time), "00")
NomCompletFichier = ChDir & "\" & NomFichier & stHeureExport
 
'Création Dossier si il n'est pas présent'
NomDossier = Application.ActiveWorkbook.Path & "\Fiche_Notification"
If Dir(NomDossier, vbDirectory) = "" Then MkDir NomDossier
 
'Copie de la feuille courante dans un nouveau classeur et enregistrement'
'XLS'
N.Copy
ActiveWorkbook.SaveAs Filename:=NomCompletFichier
 
'PDF'
N.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomCompletFichier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False
 
'ActiveWorkbook.Close
 
'Boite texte'
MsgBox "Le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier & vbCrLf
 
'code de remise à zéro des donnée...
End Sub

[Édition]
Bonjour Theze on s'est croisé...

**Syllox** · 12/08/2014, 10h16

Merci beaucoup pour vos deux réponses.
Je teste ça et je vous tiens au courant.

En gros ma boucle devrait me permettre à partir d'un tableau présent dans la feuille info de créer plusieurs feuilles distinctes remplies chacune avec une ligne de ce tableau.
Je sais pas si cela est compréhensible.

Autre exemple :

J'ai mon tableau :
Nom Prénom Age
Dupont Antoine 43
José Raymond 12

La boucle permettrait de prendre la première ligne et de coller dans une feuille à part déjà bien mise en page et ensuite enregistrer juste celle ci.
Puis de passer à la deuxième ligne et ainsi de suite.

PS: Comment faire une condition de sortir dans la boucle quand les lignes sont vides ? "Exit For" ?

Merci d'avance,

Pierre

Edit : Programme testé, cela est beaucoup plus clair déjà ! Merci !

Remplir une procédure plusieurs fois grâce à un tableau excel [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager