Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 05/12/2011, 20h02   #1
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Bonsoir à tous,

A chaque jour sa difficulté.
Chaque "bout de mon programme" écrit (avec parfois votre aide), m'amène vers d'autres lignes de codes et ... leurs lots de difficultés.
Alors ... Mon problème du jour. Il me semblait pourtant banal d'écrire ces quelques lignes ... hélas "ça passe pas" et je ne comprends pas pourquoi.
Voici le problème.

J'ai un programme principal qui contient mes macros.
L'une d'elle me permet d'ouvrir des fichiers déjà enregistrés sur le disque dur. A l'ouverture de ces fichiers, je crée deux boutons sur ces fichier qui s'ouvrent, l'un pour Imprimer, l'autre pour Enregistrer. Avec votre aide, tout cela fonctionne très bien.
Donc je me trouve avec mon "FichierOuvert" au premier plan par rapport à mon "ClasseurPrincipal". Après l'enregistrement de mon "FichierOuvert" et avant de le refermer, je souhaiterais agir sur l'une des feuilles de mon "ClasseurPrincipal".

C'est là que se situe mon problème. Il me faut "repasser" mon "ClasseurPrincipal" au plemier plan (ce que j'ai fait (il me semble) avec "Minimized", ensuite, je sélectionne bien la feuille concernée, mais je ne parviens pas à me positionner dessus (je dois, au départ, me placer en A4, puis sélectionner, dans cette colonne, la plage de cellule qui contient des données).
Une fois la feuille sélectionnée, sur mes commandes : Range ("A4").Select,, par exemple, je reçois le message : Erreur 1004, La méthode Select de la classe range a échoué.

Voici le "bout de code concerné" :

Code :
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
 
'En fonction de la variable FacDev, le fichier sera enregistré dans un répertoire ou un autre
 
If FacDev = "Facture" Then
    CheminFichier = ThisWorkbook.Path & "\"
    NomFichier = ActiveWorkbook.Name
    LongNomFichier = Len(NomFichier)
    NomFichier = Mid(NomFichier, 1, LongNomFichier - 4)
'
'Je sauvegarde le fichier ouvert
 
        With ActiveWorkbook
        .SaveAs Filename:=CheminFichier & NomFichier
'
'Je minimise le classeur que je viens de sauvegarder
'pour retrouver le ClasseurPrincipal
 
Application.WindowState = xlMinimized
 
            NomProgramme = ActiveWorkbook.Name
'
            If Préparateur = "Toto" Then
 
'Les deux ligne suivantes "passe bien"
 
                Workbooks(NomProgramme).Activate
                Sheets("Factures Toto").Activate
 
'C'est ici que le problème se pose. Il se produit sur les deux lignes               
 
                Range("A4").Select
                Range("A4", [A4].End(xlDown)).Select
 
'Je récupère le nombre de lignes "utilisées" dans la colonne
'puis je teste chaque cellule pour trouver celle qui porte
'le nom du fichier que j'ai rouvert et re-sauvegardé
 
                NombreLignes3 = Selection.Rows.Count
                Range("A4").Select
'
                    For i = 1 To NombreLignes3
                        If ActiveCell.Value <> NomFichier Then
                            ActiveCell.Offset(1, 0).Select
 
'Lorsque j'ai trouvé le nom du fichier, je supprime la ligne de celui-ci
 
                        Else: Selection.EntireRow.Delete
                        End If
                    Next
Voilà, j'espère avoir été assez clair.

Encore une fois, merci de votre aide pour ce problème qui, je le pense doit être d'une grande évidence pour beaucoup ...

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 05/12/2011, 20h53   #2
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

Non, il ne faut pas procéder ainsi, il te faut créer 2 variables Workbook pointant chacune sur un des classeurs, il n'est ainsi plus utile de faire apparaître est disparaître les classeurs. Il faut d'ailleurs éviter de faire ainsi, le résultat est parfois... aléatoire.

Met une plus grande partie de ton code (surtout le début)

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 10
Vieux 06/12/2011, 11h44   #3
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Bonjour Qwazerty,

Décidement, je crois que je "nage un peu ...".
De plus, à force de modifier mon code et d'ajouter tout un tas de lignes ... je suis un peu perdu !
J'ai compris le but de ta proposition mais je ne parviens pas à "transférer" ma variable "NomClasseurPrincipal" (classeur sur lequel je travaille et sur lequel j'ai mes macros). Lorsque je suis sur le classeur de ma feuille ouverte (qui est maintenant ma feuille active) et que je veux lancer ma procédure "Enregistrer", je "plante". Si je regarde mes variables dans la fenêtre Visual Basic, je ne trouve rien ou alors ma variable ne contient rien.

Je te fournis tout le code :
1 - Du module qui me lance mon UserForm avec mes ListView et qui après le clic sur le CommandButton1, m'ouvre mon fichier et place les boutons.

Code :
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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
Public NomFichier As String
Public CheminFichier As String
Public CeClasseur As String
Public Enregistrer As String
Public Imprimer As String
Public FacDev As String
Public Préparateur As String
Public NomduClasseur As String
Public NbItemsList1 As Integer
Public NbItemsList2 As Integer
Public NbItemsList3 As Integer
Public NomClasseurPrincipal As String
 
Sub Bilan_Factures_Non_Payées()
 
NomClasseurPrincipal = ActiveWorkbook.Name
 
    UserForm6.Show
 
End Sub
Private Sub CommandButton1_Click()
 
Dim i As Integer
Dim Fichier_à_ouvrir As String
Dim Chemin As String
Dim Bouton_Enr1 As OLEObject
Dim Bouton_Imp1 As OLEObject
 
'-------------------------------------------------------------------------
For i = 1 To ListView1.ListItems.Count
    If ListView1.ListItems(i).Selected = True Then
        Fichier_à_ouvrir = ListView1.ListItems(i).Text
        Chemin = "E:\Dir1\Dir2\Dir3\Dir4\Dir5\" & Fichier_à_ouvrir & ".xls"
        Workbooks.Open Filename:=Chemin
 
        Set NomClasseur1 = ActiveWorkbook
 
        Range("C5").Select
 
        On Error Resume Next
        Set Bouton_Enr1 = ActiveSheet.OLEObjects("Enregistrer")
        On Error GoTo 0
            If Bouton_Enr1 Is Nothing Then
                Set Bouton_Enr1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Enr1
                .Name = "Enregistrer"
                .Left = 10
                .Top = 30
                .Width = 60
                .Height = 25
                .Object.Caption = "Enregistrer"
                End With
            End If
 
AjoutCodeEnregistrer1
 
        On Error Resume Next
        Set Bouton_Imp1 = ActiveSheet.OLEObjects("Imprimer")
        On Error GoTo 0
            If Bouton_Imp1 Is Nothing Then
                Set Bouton_Imp1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Imp1
                .Name = "Imprimer"
                .Left = 10
                .Top = 60
                .Width = 60
                .Height = 25
                .Object.Caption = "Imprimer"
                End With
            End If
 
AjoutCodeImprimer1
 
    End If
Next
'-------------------------------------------------------------------------
For j = 1 To ListView2.ListItems.Count
   If ListView2.ListItems(j).Selected = True Then
        Fichier_à_ouvrir = ListView2.ListItems(j).Text
        Chemin = "E:\Dir1\Dir2\Dir3\Dir4\Dir5\" & Fichier_à_ouvrir & ".xls"
 
        Workbooks.Open Filename:=Chemin
 
        Set NomClasseur1 = ActiveWorkbook
 
        Range("C5").Select
 
        On Error Resume Next
        Set Bouton_Enr1 = ActiveSheet.OLEObjects("Enregistrer")
        On Error GoTo 0
            If Bouton_Enr1 Is Nothing Then
                Set Bouton_Enr1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Enr1
                .Name = "Enregistrer"
                .Left = 10
                .Top = 30
                .Width = 60
                .Height = 25
                .Object.Caption = "Enregistrer"
                End With
            End If
 
AjoutCodeEnregistrer1
 
        On Error Resume Next
        Set Bouton_Imp1 = ActiveSheet.OLEObjects("Imprimer")
        On Error GoTo 0
            If Bouton_Imp1 Is Nothing Then
                Set Bouton_Imp1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Imp1
                .Name = "Imprimer"
                .Left = 10
                .Top = 60
                .Width = 60
                .Height = 25
                .Object.Caption = "Imprimer"
                End With
            End If
 
AjoutCodeImprimer1
 
    End If
Next
'---------------------------------------------------------------------------
For k = 1 To ListView3.ListItems.Count
    If ListView3.ListItems(k).Selected = True Then
        Fichier_à_ouvrir = ListView3.ListItems(k).Text
        Chemin = "E:\Dir1\Dir2\Dir3\Dir4\Dir5\" & Fichier_à_ouvrir & ".xls"
        Workbooks.Open Filename:=Chemin
 
        Set NomClasseur1 = ActiveWorkbook
 
        Range("C5").Select
 
        On Error Resume Next
        Set Bouton_Enr1 = ActiveSheet.OLEObjects("Enregistrer")
        On Error GoTo 0
            If Bouton_Enr1 Is Nothing Then
                Set Bouton_Enr1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Enr1
                .Name = "Enregistrer"
                .Left = 10
                .Top = 30
                .Width = 60
                .Height = 25
                .Object.Caption = "Enregistrer"
            End With
            End If
 
AjoutCodeEnregistrer1
 
        On Error Resume Next
        Set Bouton_Imp1 = ActiveSheet.OLEObjects("Imprimer")
        On Error GoTo 0
            If Bouton_Imp1 Is Nothing Then
                Set Bouton_Imp1 = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
                With Bouton_Imp1
                .Name = "Imprimer"
                .Left = 10
                .Top = 60
                .Width = 60
                .Height = 25
                .Object.Caption = "Imprimer"
                End With
            End If
 
AjoutCodeImprimer1
 
    End If
Next
'---------------------------------------------------------------------------
End Sub
 
Private Sub CommandButton2_Click()
 
Unload Me
 
End Sub
 
Private Sub Label1_Click()
 
End Sub
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub Label4_Click()
 
End Sub
 
Private Sub Label5_Click()
 
End Sub
 
Private Sub Label6_Click()
 
End Sub
 
Private Sub Label7_Click()
 
End Sub
 
Private Sub Label8_Click()
 
End Sub
 
Private Sub Label9_Click()
 
End Sub
 
Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
 
End Sub
 
Private Sub ListView2_BeforeLabelEdit(Cancel As Integer)
 
End Sub
 
Private Sub ListView3_BeforeLabelEdit(Cancel As Integer)
 
End Sub
 
Private Sub TextBox1_Change()
 
End Sub
 
Private Sub TextBox2_Change()
 
End Sub
 
Private Sub TextBox3_Change()
 
End Sub
 
Private Sub UserForm_Initialize()
 
'----- remplissage ListView------------------------
 
ListView1.Gridlines = True
Me.ListView1.CheckBoxes = True
ListView1.MultiSelect = True
 
 
    With ListView1
        'Définit le nombre de colonnes et Entêtes
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajoute 4 colonnes en spécifiant le nom de l'entête
            'la largeur des colonnes et centre
            .Add , , "Nom Facture", 130
            .Add , , "Montant", 40, lvwColumnCenter
            .Add , , "Relance Mail", 60, lvwColumnCenter
            .Add , , "Relance Courrier", 70, lvwColumnCenter
        End With
 
        'Remplissage des colonnes
 
        Sheets("Factures J").Select
        Range("A4").Select
 
        n = 1
        m = 1
        p = 1
 
        Do While Not (IsEmpty(ActiveCell))
            i = ActiveCell
                 With .ListItems
                        .Add , , i
                 End With
            Selection.Offset(0, 1).Select
 
            j = ActiveCell
                .ListItems(n).ListSubItems.Add , , j
            Selection.Offset(0, 1).Select
 
            k = ActiveCell
                .ListItems(m).ListSubItems.Add , , k
            Selection.Offset(0, 1).Select
 
            l = ActiveCell
                .ListItems(p).ListSubItems.Add , , l
            Selection.Offset(1, -3).Select
 
            n = n + 1
            m = m + 1
            p = p + 1
 
        Loop
 
    End With
 
    ListView1.ListItems(1).Selected = False
    Set ListView1.SelectedItem = Nothing
'---------------------------------------------------------------
    ListView2.Gridlines = True
    Me.ListView2.CheckBoxes = True
    ListView2.MultiSelect = True
 
 
    With ListView2
        'Définit le nombre de colonnes et Entêtes
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajoute 4 colonnes en spécifiant le nom de l'entête
            'la largeur des colonnes et centre
            .Add , , "Nom Facture", 130
            .Add , , "Montant", 40, lvwColumnCenter
            .Add , , "Relance Mail", 60, lvwColumnCenter
            .Add , , "Relance Courrier", 70, lvwColumnCenter
        End With
 
        'Remplissage des colonnes
 
        Sheets("Factures J-F").Select
        Range("A4").Select
 
        n = 1
        m = 1
        p = 1
 
        Do While Not (IsEmpty(ActiveCell))
            i = ActiveCell
                 With .ListItems
                        .Add , , i
                 End With
            Selection.Offset(0, 1).Select
 
            j = ActiveCell
                .ListItems(n).ListSubItems.Add , , j
            Selection.Offset(0, 1).Select
 
            k = ActiveCell
                .ListItems(m).ListSubItems.Add , , k
            Selection.Offset(0, 1).Select
 
            l = ActiveCell
                .ListItems(p).ListSubItems.Add , , l
            Selection.Offset(1, -3).Select
 
            n = n + 1
            m = m + 1
            p = p + 1
 
        Loop
 
    End With
 
    ListView2.ListItems(1).Selected = False
    Set ListView2.SelectedItem = Nothing
'---------------------------------------------------------
    ListView3.Gridlines = True
    Me.ListView3.CheckBoxes = True
    ListView3.MultiSelect = True
 
 
    With ListView3
        'Définit le nombre de colonnes et Entêtes
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajoute 4 colonnes en spécifiant le nom de l'entête
            'la largeur des colonnes et centre
            .Add , , "Nom Facture", 130
            .Add , , "Montant", 40, lvwColumnCenter
            .Add , , "Relance Mail", 60, lvwColumnCenter
            .Add , , "Relance Courrier", 70, lvwColumnCenter
        End With
 
        'Remplissage des colonnes
 
        Sheets("Factures S").Select
        Range("A4").Select
 
        n = 1
        m = 1
        p = 1
 
        Do While Not (IsEmpty(ActiveCell))
            i = ActiveCell
                 With .ListItems
                        .Add , , i
                 End With
            Selection.Offset(0, 1).Select
 
            j = ActiveCell
                .ListItems(n).ListSubItems.Add , , j
            Selection.Offset(0, 1).Select
 
            k = ActiveCell
                .ListItems(m).ListSubItems.Add , , k
            Selection.Offset(0, 1).Select
 
            l = ActiveCell
                .ListItems(p).ListSubItems.Add , , l
            Selection.Offset(1, -3).Select
 
            n = n + 1
            m = m + 1
            p = p + 1
 
        Loop
 
    End With
 
    ListView3.ListItems(1).Selected = False
    Set ListView3.SelectedItem = Nothing
    '--------------------------------------------------
 
    'Spécifie l'affichage en mode "Détails"
 
    ListView1.View = lvwReport
    ListView2.View = lvwReport
    ListView3.View = lvwReport
 
Sheets("Factures J").Select
 
Columns("B:B").Find("----------", [B1], , , , xlPrevious).Select
ActiveCell.Offset(-1, 0).Select
MontantDuJ = ActiveCell.Value
TextBox1.Value = MontantDuJ
 
Sheets("Factures J-F").Select
 
Columns("B:B").Find("----------", [B1], , , , xlPrevious).Select
ActiveCell.Offset(-1, 0).Select
MontantDuJF = ActiveCell.Value
TextBox2.Value = MontantDuJF
 
Sheets("Factures S").Select
 
Columns("B:B").Find("----------", [B1], , , , xlPrevious).Select
ActiveCell.Offset(-1, 0).Select
MontantDuS = ActiveCell.Value
TextBox3.Value = MontantDuS
 
End Sub
 
Sub AjoutCodeEnregistrer1()
'Référence à ajouter Microsoft Visual Basic for Application Extsensibility 5.3
Dim CeClasseur As VBComponent
Dim i As Integer
Dim NumCom As Integer
Dim Nom As String
Dim FacDev As String
Dim CheminFichier As String
Dim NomFichier As String
Dim Préparateur As String
 
Set CeClasseur = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
 
With CeClasseur.CodeModule
    i = .CountOfLines
    .InsertLines i + 1, "Public NomClasseurPrincipal As String"
    .InsertLines i + 2, "Sub Enregistrer_Click()"
    .InsertLines i + 3, "Dim CheminFichier As String"
    .InsertLines i + 4, "Dim NomFichier As String"
    .InsertLines i + 5, "Dim LongNomFichier As Integer"
    .InsertLines i + 6, "Dim FacDev As String"
    .InsertLines i + 7, "Dim Préparateur As String"
    .InsertLines i + 8, "Dim NomduClasseur As String"
    .InsertLines i + 9, "Dim i As Integer"
    .InsertLines i + 10, "Dim NombreLignes1 As Integer"
    .InsertLines i + 11, "Dim NombreLignes2 As Integer"
    .InsertLines i + 12, "Dim NombreLignes3 As Integer"
    .InsertLines i + 13, "'"
    .InsertLines i + 14, "'"
    .InsertLines i + 15, "Range(""C5"").Select"
    .InsertLines i + 16, "ActiveCell.Select"
    .InsertLines i + 17, "ActiveCell.Offset(-2,3).Select"
    .InsertLines i + 18, "FacDev = ActiveCell.Value"
    .InsertLines i + 19, "Range(""J14"").select"
    .InsertLines i + 20, "Préparateur = ActiveCell.value"
    .InsertLines i + 21, "'"
    .InsertLines i + 22, "If FacDev=""Facture"" Then"
    .InsertLines i + 23, "CheminFichier = ThisWorkbook.Path & ""\"""
    .InsertLines i + 24, "NomFichier = ActiveWorkbook.Name"
    .InsertLines i + 25, "LongNomFichier = Len(NomFichier)"
    .InsertLines i + 26, "NomFichier = Mid(NomFichier,1,LongNomFichier-4)"
    .InsertLines i + 27, "'"
    .InsertLines i + 28, "With ActiveWorkbook"
    .InsertLines i + 29, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 30, "NomClasseurPrincipal.Activate"
    .InsertLines i + 31, "'"
    .InsertLines i + 32, "'"
    .InsertLines i + 33, "If Préparateur = ""S"" Then"
    .InsertLines i + 34, "Sheets(""Factures S"").Select"
    .InsertLines i + 35, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 36, "NombreLignes3 = Selection.Rows.Count"
    .InsertLines i + 37, "Range(""A4"").select"
    .InsertLines i + 38, "'"
    .InsertLines i + 39, "For i=1 To NombreLignes3"
    .InsertLines i + 40, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 41, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 42, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 43, "End If"
    .InsertLines i + 44, "Next"
    .InsertLines i + 45, "'"
    .InsertLines i + 46, "ElseIf Préparateur = ""J"" Then"
    .InsertLines i + 47, "Sheets(""Factures J"").Select"
    .InsertLines i + 48, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 49, "NombreLignes1 = Selection.Rows.Count"
    .InsertLines i + 50, "Range(""A4"").select"
    .InsertLines i + 51, "'"
    .InsertLines i + 52, "For i=1 To NombreLignes1"
    .InsertLines i + 53, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 54, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 55, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 56, "End If"
    .InsertLines i + 57, "Next"
    .InsertLines i + 58, "'"
    .InsertLines i + 59, "Else: Préparateur = ""J-F"""
    .InsertLines i + 60, "Sheets(""Factures J-F"").Select"
    .InsertLines i + 61, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 62, "NombreLignes2 = Selection.Rows.Count"
    .InsertLines i + 63, "Range(""A4"").select"
    .InsertLines i + 64, "'"
    .InsertLines i + 65, "'"
    .InsertLines i + 66, "For i=1 To NombreLignes2"
    .InsertLines i + 67, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 68, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 69, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 70, "End If"
    .InsertLines i + 71, "Next"
    .InsertLines i + 72, "'"
    .InsertLines i + 73, "End If"
    .InsertLines i + 74, "'"
    .InsertLines i + 75, "Exit Sub"
    .InsertLines i + 76, ".Close"
    .InsertLines i + 77, "End With"
    .InsertLines i + 78, "'"
    .InsertLines i + 79, "Else: CheminFichier = ThisWorkbook.Path & ""\"""
    .InsertLines i + 80, "NomFichier = ActiveWorkbook.Name"
    .InsertLines i + 81, "LongNomFichier = Len(NomFichier)"
    .InsertLines i + 82, "NomFichier = Mid(NomFichier,1,LongNomFichier-4)"
    .InsertLines i + 83, "'"
    .InsertLines i + 84, "With ActiveWorkbook"
    .InsertLines i + 85, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 86, "'"
    .InsertLines i + 87, "'"
    .InsertLines i + 88, "'"
    .InsertLines i + 89, "If Préparateur = ""S"" Then"
    .InsertLines i + 90, "Sheets(""Factures S"").Select"
    .InsertLines i + 91, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 92, "NombreLignes3 = Selection.Rows.Count"
    .InsertLines i + 93, "Range(""A4"").select"
    .InsertLines i + 94, "'"
    .InsertLines i + 95, "For i=1 To NombreLignes3"
    .InsertLines i + 96, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 97, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 98, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 99, "End If"
    .InsertLines i + 100, "Next"
    .InsertLines i + 101, "'"
    .InsertLines i + 102, "ElseIf Préparateur = ""J"" Then"
    .InsertLines i + 103, "Sheets(""Factures J"").Select"
    .InsertLines i + 104, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 105, "NombreLignes1 = Selection.Rows.Count"
    .InsertLines i + 106, "Range(""A4"").select"
    .InsertLines i + 107, "'"
    .InsertLines i + 108, "For i=1 To NombreLignes1"
    .InsertLines i + 109, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 110, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 111, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 112, "End If"
    .InsertLines i + 113, "Next"
    .InsertLines i + 114, "'"
    .InsertLines i + 115, "Else: Préparateur = ""J-F"""
    .InsertLines i + 116, "Sheets(""Factures J-F"").Select"
    .InsertLines i + 117, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 118, "NombreLignes2 = Selection.Rows.Count"
    .InsertLines i + 119, "Range(""A4"").select"
    .InsertLines i + 120, "'"
    .InsertLines i + 121, "'"
    .InsertLines i + 122, "For i=1 To NombreLignes2"
    .InsertLines i + 123, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 124, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 125, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 126, "End If"
    .InsertLines i + 127, "Next"
    .InsertLines i + 128, "'"
    .InsertLines i + 129, "End If"
    .InsertLines i + 130, "'"
    .InsertLines i + 131, "Exit Sub"
    .InsertLines i + 132, ".Close"
    .InsertLines i + 133, "End With"
    .InsertLines i + 134, "'"
    .InsertLines i + 135, "End If"
    .InsertLines i + 136, "End Sub"
 
End With
 
 
End Sub
 
Sub AjoutCodeImprimer1()
 
Dim CeClasseur As VBComponent
Dim j As Integer
Dim NumLigne As Integer
Dim NumColonne As Integer
 
 
Set CeClasseur = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
 
With CeClasseur.CodeModule
    j = .CountOfLines
    .InsertLines j + 1, "Sub Imprimer_Click()"
    .InsertLines j + 2, "'"
    .InsertLines j + 3, "Dim NumLigne As Integer"
    .InsertLines j + 4, "Dim NumColonne As Integer"
    .InsertLines j + 5, "'"
    .InsertLines j + 6, "Columns(""J:J"").Find(""----------"", [J1], , , , xlPrevious).Select"
    .InsertLines j + 7, "ActiveCell.Offset(-1, 0).Select"
    .InsertLines j + 8, "'"
    .InsertLines j + 9, "NumLigne = ActiveCell.Row"
    .InsertLines j + 10, "NumColonne = ActiveCell.Column"
    .InsertLines j + 11, "'"
    .InsertLines j + 12, "Range(""A1"" & "":J"" & NumLigne).Select"
    .InsertLines j + 13, "'"
    .InsertLines j + 14, "With Sheets(""Fac - Dev"").PageSetup"
    .InsertLines j + 15, ".PrintArea = ""A1"" & "":J"" & NumLigne"
    .InsertLines j + 16, ".PaperSize = xlPaperA4"
    .InsertLines j + 17, ".CenterHorizontally = True"
    .InsertLines j + 18, ".Orientation = xlPortrait"
    .InsertLines j + 19, ".Zoom = False"
    .InsertLines j + 20, ".FitToPagesWide = 1"
    .InsertLines j + 21, ".FitToPagesTall = 2"
    .InsertLines j + 22, "End With"
    .InsertLines j + 23, "Sheets(""Fac - Dev"").PrintOut"
    .InsertLines j + 24, "End Sub"
End With
 
End Sub
2 - Du code "Enregistrer" et "Imprimer" (bien que ce dernier ne pose pas de problème) qui ce place dans le module de la feuille ouverte.

Code :
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
Public NomClasseurPrincipal As String
Sub Enregistrer_Click()
Dim CheminFichier As String
Dim NomFichier As String
Dim LongNomFichier As Integer
Dim FacDev As String
Dim Préparateur As String
Dim NomduClasseur As String
Dim i As Integer
Dim NombreLignes1 As Integer
Dim NombreLignes2 As Integer
Dim NombreLignes3 As Integer
Dim NomClasseuPrincipal As String
'
'
Range("C5").Select
ActiveCell.Select
ActiveCell.Offset(-2, 3).Select
FacDev = ActiveCell.Value
Range("J14").Select
Préparateur = ActiveCell.Value
'
If FacDev = "Facture" Then
CheminFichier = ThisWorkbook.Path & "\"
NomFichier = ActiveWorkbook.Name
LongNomFichier = Len(NomFichier)
NomFichier = Mid(NomFichier, 1, LongNomFichier - 4)
'
With ActiveWorkbook
.SaveAs Filename:=CheminFichier & NomFichier
NomClasseurPrincipal.Activate
'
'
If Préparateur = "S" Then
Sheets("Factures S").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes3 = Selection.Rows.Count
Range("A4").Select
'
For i = 1 To NombreLignes3
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
ElseIf Préparateur = "J" Then
Sheets("Factures J").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes1 = Selection.Rows.Count
Range("A4").Select
'
For i = 1 To NombreLignes1
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
Else: Préparateur = "J-F"
Sheets("Factures J-F").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes2 = Selection.Rows.Count
Range("A4").Select
Range("A4").Select
'
For i = 1 To NombreLignes2
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
End If
'
Exit Sub
.Close
End With
'
Else: CheminFichier = ThisWorkbook.Path & "\"
NomFichier = ActiveWorkbook.Name
LongNomFichier = Len(NomFichier)
NomFichier = Mid(NomFichier, 1, LongNomFichier - 4)
'
With ActiveWorkbook
.SaveAs Filename:=CheminFichier & NomFichier
'
'
'
If Préparateur = "Sébastien" Then
Sheets("Factures non payées - Sébastien").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes3 = Selection.Rows.Count
Range("A4").Select
'
For i = 1 To NombreLignes3
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
ElseIf Préparateur = "Juliette" Then
Sheets("Factures non payées - Juliette").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes1 = Selection.Rows.Count
Range("A4").Select
'
For i = 1 To NombreLignes1
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
Else: Préparateur = "Jean-François"
Sheets("Factures non payées - J-F").Select
Range("A4", Range("A4").End(xlDown)).Select
NombreLignes2 = Selection.Rows.Count
Range("A4").Select
'
'
For i = 1 To NombreLignes2
If ActiveCell.Value <> NomFichier Then
ActiveCell.Offset(1, 0).Select
Else: Selection.EntireRow.Delete
End If
Next
'
End If
'
Exit Sub
.Close
End With
'
End If
End Sub
Sub Imprimer_Click()
'
Dim NumLigne As Integer
Dim NumColonne As Integer
'
Columns("J:J").Find("----------", [J1], , , , xlPrevious).Select
ActiveCell.Offset(-1, 0).Select
'
NumLigne = ActiveCell.Row
NumColonne = ActiveCell.Column
'
Range("A1" & ":J" & NumLigne).Select
'
With Sheets("Fac - Dev").PageSetup
.PrintArea = "A1" & ":J" & NumLigne
.PaperSize = xlPaperA4
.CenterHorizontally = True
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
Sheets("Fac - Dev").PrintOut
End Sub
Voilà, c'est bien long, ma manière de coder n'est certes pas très "élégante ..." Je suis encore très novice en programmation ... même si je me fais réellement plaisir en "essayant".

Encore merci.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 06/12/2011, 20h41   #4
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

Alors beaucoup de choses
J'ai modifié un grosse partie de ton code, mais il reste certainement des modification à lui apporter.
J'ai mis en place des boucle pour éviter d'avoir 3 fois le même code.

Code :
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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
Option Explicit
 
Public NomFichier As String
Public CheminFichier As String
Public CeClasseur As String
Public Enregistrer As String
Public Imprimer As String
Public FacDev As String
Public Préparateur As String
Public NomduClasseur As String
Public NbItemsList1 As Integer
Public NbItemsList2 As Integer
Public NbItemsList3 As Integer
Public NomClasseurPrincipal As String
 
Sub Bilan_Factures_Non_Payées()
 
NomClasseurPrincipal = ActiveWorkbook.Name
 
    UserForm6.Show
 
End Sub
Private Sub CommandButton1_Click()
 
Dim i As Integer, iListe As Integer
Dim Fichier_à_ouvrir As String
Dim Chemin As String
Dim Bouton_Enr1 As OLEObject
Dim Bouton_Imp1 As OLEObject
 
'On crée la variable qui pointera sur notre classeur
Dim Classeur1 As Workbook
'Pareil pour la feuille sur laquelle on va travailler
Dim LaFeuille As Worksheet
 
'-------------------------------------------------------------------------
'Si j'ai bien compris le code est le même pour les 3 listes
For iListe = 1 To 3
    With Me.Controls("ListView" & iListe)
        For i = 1 To .ListItems.Count
            If .ListItems(i).Selected = True Then
                Fichier_à_ouvrir = .ListItems(i).Text
                Chemin = "E:\Dir1\Dir2\Dir3\Dir4\Dir5\" & Fichier_à_ouvrir & ".xls"
 
                'On pointe directement le classeur retourné par Open
                Set Classeur1 = Workbooks.Open(Filename:=Chemin)
                'Set NomClasseur1 = ActiveWorkbook
 
                'Il faut déterminer sur quelle feuille tu travailles
                Set LaFeuille = Classeur1.Sheets("Feuil1") 'A adapter
 
                'Range("C5").Select'inutile
 
                On Error Resume Next
                Set Bouton_Enr1 = LaFeuille.OLEObjects("Enregistrer")
                On Error GoTo 0
                If Bouton_Enr1 Is Nothing Then
                    Set Bouton_Enr1 = LaFeuille.OLEObjects.Add("Forms.CommandButton.1")
                    With Bouton_Enr1
                        .Name = "Enregistrer"
                        .Left = 10
                        .Top = 30
                        .Width = 60
                        .Height = 25
                        .Object.Caption = "Enregistrer"
                    End With
                End If
 
                AjoutCodeEnregistrer1 LaFeuille
 
                On Error Resume Next
                Set Bouton_Imp1 = LaFeuille.OLEObjects("Imprimer")
                On Error GoTo 0
                    If Bouton_Imp1 Is Nothing Then
                        Set Bouton_Imp1 = LaFeuille.OLEObjects.Add("Forms.CommandButton.1")
                        With Bouton_Imp1
                            .Name = "Imprimer"
                            .Left = 10
                            .Top = 60
                            .Width = 60
                            .Height = 25
                            .Object.Caption = "Imprimer"
                        End With
                    End If
 
                AjoutCodeImprimer1 LaFeuille
 
            End If
        Next
    End With
Next
'-------------------------------------------------------------------------
End Sub
 
Private Sub CommandButton2_Click()
 
Unload Me 'attention parfois Me.hide est largement suffisant
'Unload détruit carrement l'instance de la UserForm, la cacher n'est il pas suffisant?
 
End Sub
 
 
Private Sub UserForm_Initialize()
Dim TheCell As Range
Dim SheetFacture As Worksheet
Dim aListItem As ListItem
Dim iList As Integer
Dim ListNomFeuille As Variant
Dim Montant As Double
'On liste la partie variable du nom des feuilles que l'on va utiliser
ListNomFeuille = Array("J", "J-F", "S")
 
 
'----- remplissage ListView------------------------
 
 
For iList = 1 To 3
    With Me.Controls("ListView" & iList)
        .Gridlines = True
        .CheckBoxes = True
        .MultiSelect = fmMultiSelectExtended
        'Définit le nombre de colonnes et Entêtes
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajoute 4 colonnes en spécifiant le nom de l'entête
            'la largeur des colonnes et centre
            .Add , , "Nom Facture", 130
            .Add , , "Montant", 40, lvwColumnCenter
            .Add , , "Relance Mail", 60, lvwColumnCenter
            .Add , , "Relance Courrier", 70, lvwColumnCenter
        End With
 
        'On pointe la feuille sur laquelle on va travailler
        Set SheetFacture = ThisWorkbook.Sheets("Factures " & ListNomFeuille(iList - 1))
 
        'On parcours les cellules de la colonne A
        For Each TheCell In SheetFacture.Range("A4:A" & SheetFacture.Cells(SheetFacture.Rows.Count, "A").End(xlUp).Row)
            'On ajoute la ligne
            Set aListItem = .ListItems.Add(Text:=TheCell)
            'Les sous items
            aListItem.ListSubItems.Add Text:=TheCell.Offset(0, 1)
            aListItem.ListSubItems.Add Text:=TheCell.Offset(0, 2)
            aListItem.ListSubItems.Add Text:=TheCell.Offset(0, 3)
        Next
        'Quel est ton but?
        .ListItems(1).Selected = False
        Set .SelectedItem = Nothing
 
        'Spécifie l'affichage en mode "Détails"
        .View = lvwReport
    End With
Next
 
'On boucle sur chaque feuille facture
For iList = 0 To 2
    With ThisWorkbook.Sheets("Factures " & ListNomFeuille(iList))
        Montant = .Columns("B:B").Find("----------", .[B1], , , , xlPrevious).Offset(-1, 0).Value
        Me.Controls(iList + 1).Value = Montant
    End With
Next
End Sub
 
Sub AjoutCodeEnregistrer1(UneFeuille As Worksheet)
'Référence à ajouter Microsoft Visual Basic for Application Extsensibility 5.3
'On passe la feuille sur laquelle on veut ajouter le code en parametre (UneFeuille)
 
'Dim CeClasseur As VBComponent
Dim i As Integer
'Inutile de déclarer des variables pour les utiliser dans le texte de ta macro
'Dim NumCom As Integer
'Dim Nom As String
'Dim FacDev As String
'Dim CheminFichier As String
'Dim NomFichier As String
'Dim Préparateur As String
 
'Set CeClasseur = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
 
With UneFeuille.Parent.VBProject.VBComponents(UneFeuille.CodeName) 'CeClasseur.CodeModule
    i = .CountOfLines
 
    'Je ne saurait que te conseiller de revoir ton code afin d'éliminer tout les Select, ActiveCell....
    'Et de pointer les feuilles et classeurs sur lesquelles tu travailles, ne serait-ce que de mettre ThisWorkbook
    .InsertLines i + 1, "Public NomClasseurPrincipal As String"
    .InsertLines i + 2, "Sub Enregistrer_Click()"
    .InsertLines i + 3, "Dim CheminFichier As String"
    .InsertLines i + 4, "Dim NomFichier As String"
    .InsertLines i + 5, "Dim LongNomFichier As Integer"
    .InsertLines i + 6, "Dim FacDev As String"
    .InsertLines i + 7, "Dim Préparateur As String"
    .InsertLines i + 8, "Dim NomduClasseur As String"
    .InsertLines i + 9, "Dim i As Integer"
    .InsertLines i + 10, "Dim NombreLignes1 As Integer"
    .InsertLines i + 11, "Dim NombreLignes2 As Integer"
    .InsertLines i + 12, "Dim NombreLignes3 As Integer"
    .InsertLines i + 13, "'"
    .InsertLines i + 14, "'"
    .InsertLines i + 15, "Range(""C5"").Select"
    .InsertLines i + 16, "ActiveCell.Select"
    .InsertLines i + 17, "ActiveCell.Offset(-2,3).Select"
    .InsertLines i + 18, "FacDev = ActiveCell.Value"
    .InsertLines i + 19, "Range(""J14"").select"
    .InsertLines i + 20, "Préparateur = ActiveCell.value"
    .InsertLines i + 21, "'"
    .InsertLines i + 22, "If FacDev=""Facture"" Then"
    .InsertLines i + 23, "CheminFichier = ThisWorkbook.Path & ""\"""
    .InsertLines i + 24, "NomFichier = ActiveWorkbook.Name"
    .InsertLines i + 25, "LongNomFichier = Len(NomFichier)"
    .InsertLines i + 26, "NomFichier = Mid(NomFichier,1,LongNomFichier-4)"
    .InsertLines i + 27, "'"
    .InsertLines i + 28, "With ActiveWorkbook"
    .InsertLines i + 29, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 30, "NomClasseurPrincipal.Activate"
    .InsertLines i + 31, "'"
    .InsertLines i + 32, "'"
    .InsertLines i + 33, "If Préparateur = ""S"" Then"
    .InsertLines i + 34, "Sheets(""Factures S"").Select"
    .InsertLines i + 35, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 36, "NombreLignes3 = Selection.Rows.Count"
    .InsertLines i + 37, "Range(""A4"").select"
    .InsertLines i + 38, "'"
    .InsertLines i + 39, "For i=1 To NombreLignes3"
    .InsertLines i + 40, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 41, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 42, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 43, "End If"
    .InsertLines i + 44, "Next"
    .InsertLines i + 45, "'"
    .InsertLines i + 46, "ElseIf Préparateur = ""J"" Then"
    .InsertLines i + 47, "Sheets(""Factures J"").Select"
    .InsertLines i + 48, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 49, "NombreLignes1 = Selection.Rows.Count"
    .InsertLines i + 50, "Range(""A4"").select"
    .InsertLines i + 51, "'"
    .InsertLines i + 52, "For i=1 To NombreLignes1"
    .InsertLines i + 53, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 54, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 55, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 56, "End If"
    .InsertLines i + 57, "Next"
    .InsertLines i + 58, "'"
    .InsertLines i + 59, "Else: Préparateur = ""J-F"""
    .InsertLines i + 60, "Sheets(""Factures J-F"").Select"
    .InsertLines i + 61, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 62, "NombreLignes2 = Selection.Rows.Count"
    .InsertLines i + 63, "Range(""A4"").select"
    .InsertLines i + 64, "'"
    .InsertLines i + 65, "'"
    .InsertLines i + 66, "For i=1 To NombreLignes2"
    .InsertLines i + 67, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 68, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 69, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 70, "End If"
    .InsertLines i + 71, "Next"
    .InsertLines i + 72, "'"
    .InsertLines i + 73, "End If"
    .InsertLines i + 74, "'"
    .InsertLines i + 75, "Exit Sub"
    .InsertLines i + 76, ".Close"
    .InsertLines i + 77, "End With"
    .InsertLines i + 78, "'"
    .InsertLines i + 79, "Else: CheminFichier = ThisWorkbook.Path & ""\"""
    .InsertLines i + 80, "NomFichier = ActiveWorkbook.Name"
    .InsertLines i + 81, "LongNomFichier = Len(NomFichier)"
    .InsertLines i + 82, "NomFichier = Mid(NomFichier,1,LongNomFichier-4)"
    .InsertLines i + 83, "'"
    .InsertLines i + 84, "With ActiveWorkbook"
    .InsertLines i + 85, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 86, "'"
    .InsertLines i + 87, "'"
    .InsertLines i + 88, "'"
    .InsertLines i + 89, "If Préparateur = ""S"" Then"
    .InsertLines i + 90, "Sheets(""Factures S"").Select"
    .InsertLines i + 91, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 92, "NombreLignes3 = Selection.Rows.Count"
    .InsertLines i + 93, "Range(""A4"").select"
    .InsertLines i + 94, "'"
    .InsertLines i + 95, "For i=1 To NombreLignes3"
    .InsertLines i + 96, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 97, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 98, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 99, "End If"
    .InsertLines i + 100, "Next"
    .InsertLines i + 101, "'"
    .InsertLines i + 102, "ElseIf Préparateur = ""J"" Then"
    .InsertLines i + 103, "Sheets(""Factures J"").Select"
    .InsertLines i + 104, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 105, "NombreLignes1 = Selection.Rows.Count"
    .InsertLines i + 106, "Range(""A4"").select"
    .InsertLines i + 107, "'"
    .InsertLines i + 108, "For i=1 To NombreLignes1"
    .InsertLines i + 109, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 110, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 111, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 112, "End If"
    .InsertLines i + 113, "Next"
    .InsertLines i + 114, "'"
    .InsertLines i + 115, "Else: Préparateur = ""J-F"""
    .InsertLines i + 116, "Sheets(""Factures J-F"").Select"
    .InsertLines i + 117, "Range(""A4"",Range(""A4"").End(xlDown)).Select"
    .InsertLines i + 118, "NombreLignes2 = Selection.Rows.Count"
    .InsertLines i + 119, "Range(""A4"").select"
    .InsertLines i + 120, "'"
    .InsertLines i + 121, "'"
    .InsertLines i + 122, "For i=1 To NombreLignes2"
    .InsertLines i + 123, "If ActiveCell.Value <> NomFichier Then"
    .InsertLines i + 124, "ActiveCell.Offset(1,0).Select"
    .InsertLines i + 125, "Else:Selection.EntireRow.Delete"
    .InsertLines i + 126, "End If"
    .InsertLines i + 127, "Next"
    .InsertLines i + 128, "'"
    .InsertLines i + 129, "End If"
    .InsertLines i + 130, "'"
    .InsertLines i + 131, "Exit Sub"
    .InsertLines i + 132, ".Close"
    .InsertLines i + 133, "End With"
    .InsertLines i + 134, "'"
    .InsertLines i + 135, "End If"
    .InsertLines i + 136, "End Sub"
 
End With
 
 
End Sub
{Je n'ai pas testé le code}
Il faut aussi revoir le code de tes boutons, pour éliminer les Select, Active...

Petit conseille, soit attentif à bien déclarer toutes tes variables, pour t'y aider place au début de ton module Option explicit, qui t'oblige à les déclarer.
Tu as déclaré beaucoup de variable de porté module (elles se trouve au début du module et ne sont pas incluses dans une des procédures) Est-ce bien utile?

Voila pour le code du bouton enregistrer
Code :
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
Option Explicit
 
'Public NomClasseurPrincipal As String
Sub Enregistrer_Click()
Dim CheminFichier As String
Dim NomFichier As String
Dim LongNomFichier As Integer
'Dim FacDev As String
Dim Préparateur As String 'il est préférable d'éviter les accent dans les nom de variables
'Dim NomduClasseur As String
'Dim i As Integer
'Dim NombreLignes1 As Integer
'Dim NombreLignes2 As Integer
'Dim NombreLignes3 As Integer
'Dim NomClasseuPrincipal As String
 
Dim iTheCell As Integer
Dim SheetFacture As Worksheet
'On peut garder l'utilisation de ActiveSheet puisque la présence du bouton
'nous assure qu'activesheet pointe bien la feuille sur laquelle on veut travailler
'Par contre autant pointer directement la cellule F3 plutot que d'utiliser C5 + offset
'
'
'il vaut mieux utiliser ThisWorkBook plutot que Activeworkbook en régle générale
With ThisWorkbook
    Préparateur = .ActiveSheet.Range("J14").Value
    '
    'Partie commune a tous les cas de figure (Facture ou imayé, donc il faut la sortir de la structure If
    CheminFichier = .Path & "\"
    NomFichier = .Name
    LongNomFichier = Len(NomFichier)
    'Attention les extensions n'ont pas toujours 3 lettres, il existe des méthodes plus polyvalente si besoin
    NomFichier = Mid(NomFichier, 1, LongNomFichier - 4)
    '
    .SaveAs Filename:=CheminFichier & NomFichier
 
    'On defini la feuille su laquelle on va travailler en fct° du type de document
    If .ActiveSheet.Range("F3").Value = "Facture" Then
        Set SheetFacture = .Sheets("Facture " & Préparateur)
    Else
        Set SheetFacture = .Sheets("Factures non payées - " & Préparateur)
    End If
    'NomClasseurPrincipal est une variable string, pas une variable classeur (workbook)
    'De plus tu n'indique nulle part a quoi elle correspond
    'Si c'est pour remettre le classeur ou se trouve la macro au premier plan
    'c'est inutile puisqu'on utilise ThisWorkbook, qui pointera forcement le classeur contenant la macro qui s'execute
    'NomClasseurPrincipal.Activate
    '
    'On détermine le nom de la feuille sur laquelle on va travailler
    'Je ne fait pas de verification pour être sûr que la feuille existe... a toi de voir si c'est utile
    With SheetFacture
        'En régle géneral on par toujours du bas vers le haut pour trouver la derniere cellule non vide (xlUp)
        'Ici je n'utilise pas For each, puisque le but est de supprimer des ligne
        'Dans un tel cas, il faut toujours commencer par le bas de la liste
        For iTheCell = .Cells(.Rows.Count, "A").End(xlUp).Row To 4 Step -1
            'On efface la ligne faisant référence au nom du fichier
            If .Cells(iTheCell, "A").Value = NomFichier Then .Cells(iTheCell, "A").EntireRow.Delete
        Next
    End With
    '
    'Exit Sub 'ici tu quitte sans executer ce qui suit
    '.Close 'cette ligne ne sera jamais exevcutée
End With
 
End Sub
Je te laisse lire les commentaire et faire du ménage avant de d'utiliser ce code (s'il fonctionne correctement) pour refaire le code de création du contenu du bouton.

Essai de modifier le code du bouton Imprimer je suis claqué

Un autre point, attention avec tes structure If, Elseif, Else, tu devrais lire ou relire un tutoriel a se sujet, tes structures sont fausses. Personnellement j'évite d'utiliser les : pour mettre les lignes de codes à la queue leuleu, c'est juste bon pour faire des erreurs de fermeture d'imbrication et ça rend le code difficile à entretenir par la suite.

Bonne nuit!
++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/12/2011, 19h39   #5
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Salut Qwazerty,

Alors là, tu m'épates !

Cette longue réponse avec tes remarques m'impressionne.
J'imprime et j'étudie cela. Je te tiens au courant.

Merci.

Danad38

Re Bonjour Qwazerty,

J'ai étudié ton travail. Ta manière de "simplifier" le programme me laisse encore plein d'admiration !
J'essaie de retenir la leçon ...

Il aurait été "trop" simple que tout fonctionne à merveille, il faut bien qu'il me reste quelques recherches à effectuer. Là pourtant je coince.

Au lancement du programme principal j'ai systématiquement "une erreur 438 : Propriété ou méthode non gérée par cet objet" qui survient et qui me ramène sur la ligne de départ de mon programme : "UserForm6.Show".

Après avoir suivi le déroulement du programme pas à pas, j'ai trouvé où se situe l'erreur mais je ne parviens pas à la supprimer. Mes recherches sur le Net n'ont pas abouti. Je n'ai pas trouvé de cas suffisamment semblables.

L'erreur survient à la ligne 158 :

Code :
Montant=.Columns("B:B").Find("----------",.[B1],,,,xlPrevious).Offset(-1,0).Value
As-tu une idée ?

Je n'arrive pas au stade de l'apparition de mon UserForm donc je ne sais pas s'il sera correctement rempli, mais le balayage des feuilles semble s'effectuer correctement, les variables semblent elles aussi bonnes.

Merci encore.

Danad38

Salut Qwazerty,

Décidément, à force de lire, relire et modifier, je ne vois même plus les erreurs les plus simples !

Dans la ligne qui "plantait", j'avais tout simplement effacé le "s" de Columns !
... Et l'ordinateur ne m'a rien dit !

J'ai alors crié victoire ...mais, le même message d'erreur, avec le même effet de l'arrêt du programme, est venu à la ligne suivante :

Code :
Me.Controls(iList + 1).Value = Montant
Désolé pour le dernier message ...

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/12/2011, 20h45   #6
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

En programmation il est important de savoir manipuler les boucles pour limiter la quantité de code.

Voila la correction, j'en ai profité pour aussi vérifier qu'une cellule est bien trouvée par Find

Code :
1
2
3
4
5
6
7
8
'On boucle sur chaque feuille facture
For iList = 0 To 2
    With ThisWorkbook.Sheets("Factures " & ListNomFeuille(iList))
        Set TheCell = .Columns("B:B").Find("----------", .[B1], , , , xlPrevious)
        'On verifie qu'une cellule a bien été trouvée
        If Not TheCell Is Nothing Then Me.Controls("TextBox" & iList + 1).Value = TheCell.Offset(-1, 0).Value
    End With
Next
Si tu as besoin d'explications demande.

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/12/2011, 16h46   #7
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

J'ai bien étudié ta réponse. (Hier soir, à la suite de mon erreur d'écriture, et devant la seconde erreur survenue immédiatement sur la ligne suivante, j'avoue ne pas avoir beaucoup cherché avant "d'appeler de l'aide". Le fait que le contrôle (Me.Controls) ne soit pas défini m'est apparu plus tard dans la soirée ...). D'habitude je m'efforce de chercher au maximum par moi même ...

Voici donc l'état d'avancement de mon programme.

J'ai été amené à effectuer une modification car le programme plantait. Je ne sais pas si mon action est très judicieuses mais ça ne plante plus. Voici cette modification :
Programme principal :
1 - Ligne 186, j'ai ajouté .CodeModule en fin de ligne.

Code :
With UneFeuille.Parent.VBProject.VBComponents(UneFeuille.CodeName).CodeModule
Outre un certain nombre (encore) de fautes de frappe ... décidement !
tout va bien pour l'ouverture du UserForm, les ListView et les Totaux sont corrects, les sélections sans problèmes.

MAIS une fois ma feuille ouverte, losrque je lance la procédure d'enregistrement, elle commence par se dérouler correctement (Le fichier s'enregistre) mais après, alors que ce fichier est encore à l'écran et qu'il faut re-basculer sur la feuille des listes des factures du programme principal (Pour supprimer la ligne qui contient le nom de cette facture), ça plante avec le message : "L'indice n'appartient pas à la sélection"

C'est à la ligne 40 du programme "Enregistrer_Click()":

Code :
Set SheetFacture = .Sheets("Facture " & Préparateur)
(Pour simplifier, j'ai considéré, dans un premier temps, que tous les fichiers avaient en J3 le mot "Facture" ce qui m'élimine le Else dans la boucle).

J'ai "aménagé" le programme "Imprimer" qui semble fonctionner, lui, sans problème.

Qu'en penses-tu ?

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/12/2011, 19h11   #8
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

Pour la 1ere correction, c'est parfait.

Par contre pour ton 2ème soucis, tu as supprimer le teste du contenu de la cellule F3 si j'ai bien compris, donc ceci
Code :
1
2
3
4
5
    If .ActiveSheet.Range("F3").Value = "Facture" Then
        Set SheetFacture = .Sheets("Facture " & Préparateur)
    Else
        Set SheetFacture = .Sheets("Factures non payées - " & Préparateur)
    End If
est devenu cela
Code :
Set SheetFacture = .Sheets("Facture " & Préparateur)
Dans ce cas, cela veut dire que toutes les feuilles auxquelles tu vas faire référence à partir de ce code, auront un nom qui débutera par "Facture " suivi du nom du préparateur (identifié en cellule J14) et que par conséquent, tu n'auras pas de feuille nommé "Factures non payées - " suivi du nom du Préparateur. Es-tu sur de voila cela? Car étant donné le message d'erreur, il ne trouve pas de feuille nommée "Facture " suivi du nom du Préparateur.

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 09/12/2011, 09h42   #9
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

Je vais essayer d'être plus précis.
Dans mes premiers messages, j'ai utilisé des "noms" qui n'étaient pas forcement ceux, réels, des feuilles et fichiers. Jusqu'à maintenant, j'ai toujours pu "rétablir" l'équilibre. Aujourd'hui, c'est peut-être cela qui cloche.

J'ai donc un classeur, disons "général" dans lequel j'ai toutes les feuilles relatives à mon programme. C'est dans ce classeur que sont stockées mes macros.

Dans ce classeur, il y a 3 feuilles nommées exactement : "Fact non payées - Sébastien" ; "Fact non payées - Juliette" et "Fact non payées - Jean-François".
Chacune de ces feuilles contient une liste de noms de factures encore non payées. Ces noms sont tous du style : Date-Numéro-Nom, par exemple "9-12-2011-124-MACHIN".
Ce sont ces listes qui alimentent les ListViews du UserForm.

Chacun de ces noms ("9-12-2011-124-MACHIN" ...) correspond à un fichier enregistré sur le disque. Le nom du fichier est le même : "9-12-2011-124-MACHIN.xls". Enfin, chacune de ces factures ne contient qu'une seule feuille nommée : "Facture - Devis en cours".

Au lancement de ma macro, voici ce qui doit se passer :
1 - Initialisation du UserForm. (Au passage, récupération du montant global encore non payé pour chaque ListView).
2 - Choix d'un (ou plussieurs) fichier dans une des ListViews.
3 - Après clic sur un CommandButton, ouverture du (ou des) fichier.
4 - Placement sur la (ou les) feuille de 2 boutons "Enregistrer" et "Imprimer".
5 - Fermeture du UserForm.

A ce moment, j'ai à l'écran mon (ou mes) fichier facture. Je peux inscrire la date du paiement ... Etc.
Puis je peux imprimer si nécessaire et enregistrer ce fichier avec le même nom, au même endroit du disque.

Jusque là ... tout va bien...

Ensuite il me faudra fermer le fichier corrigé (à quel moment le fermer ?), il faut également "basculer" sur la feuille "Fact non payée - ...Nom du préparateur" du classeur principal afin de retrouver le nom de cette facture et ensuite supprimer la ligne contenant ce nom.

C'est au moment de cette "bascule" que le problème se pose.

Si j'ai, provisoirement, considéré que la cellule F3 portait toujours le mot "Facture" (plus tard j'envisage autre chose si ce mot est "Devis"), j'ai gardé le test, cela donne sur mon programme :

Code :
1
2
3
If .ActiveSheet.Range("F3").Value="Facture" Then
    Set SheetFacture=.Sheets("Fact non payées - " & Préparateur)
    End If
Parvenu sur la ligne de code :

Code :
Set SheetFacture=.Sheets("Fact non payées - " & Préparateur)
il se produit un plantage "sévère" puisque Excel se ferme, redémarre, mais, ensuite, reste bloqué, pas moyen de faire quoi que ce soit ni de fermer le logiciel ... reste le bon vieux Ctrl+Alt+Suppr ...

Voilà ou j'en suis en ce moment.

J'espère, cette fois, avoir été suffisamment précis afin que tu puisses y voir plus clair dans ma démarche.

Bonne journée.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 11/12/2011, 07h36   #10
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut
Donc si je comprend bien,

Tu sélectionnes les factures que les clients viennent de payer.

Un proposition, plutôt que d'ouvrir toutes tes fenêtres d'un coup, pourquoi ne pas les ouvrir une par une?
  1. Tu séléctionnes tes factures dans les listes
  2. Tu cliques sur ton bouton "Afficher" (celui de ta UserForm)
  3. Tu changes le caption de ce bouton en "Suivant"
  4. Tu charges le 1er fichier et tu le passes au 1er plan (la macro se termine, mais le UserForm reste chargé et affiché)
  5. Tu fais les modifications sur la facture affichée (à la main, mais il est possible si besoin d'en intégrer une partie (totalité? si c'est le cas ça change la donne) dans le code du bouton "Afficher/Suivant")
  6. Tu cliques sur le bouton "Suivant" (Il faudra mettre un If dans le code qui tient compte du Caption du bouton par exemple, pour adapter les action du code)
  7. Ici plusieurs fonctionnements son possible en fonction de tes besoins (?), enregistrement systématique ou non, impression systématique ou non.
  8. Ensuite la macro va chercher le nom du fichier ta la feuille du classeur "général" et détruit la ligne (ça ne tiendrais que de moi, je conserverais la ligne, je placerais juste une colonne "Payé" ou j'inscrirais la date de paiement, histoire de conserver un historique. il faudrait alors tenir compte de cette colonne pour n'afficher dans les listbox que les ligne ayant un contenu vide dans la colonne "Payé")
  9. Ensuite on affiche la facture suivante (retour au point 4)
  10. Lorsque toutes les factures ont été traitées, tu remets le caption du bouton à "Afficher" (+vider les listes+...) et tu masques la UserForm

Voila une idée de fonctionnement, regarde si ça collerait à ce que tu souhaites faire. Il peut être intéressant de savoir ce que tu saisis dans la feuille facture, est-ce les mêmes données dans toutes les factures? ou les données sont elles différentes en fonction du client/du rédacteur?

Avant de te lancer dans le code, peaufine bien l’enchaînement que tu souhaites réaliser, ensuite seulement tu pourras commencer à en réaliser l'ossature.

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 13/12/2011, 19h50   #11
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

Beaucoup d'heures devant l'écran à chercher et comprendre ... mais au bout du compte rien!
A force de "triturer" les lignes de codes, d'en ajouter, d'en supprimer j'obtiens une "usine à gaz" ... qui ne fonctionne pas! J'en suis donc revenu à mon point de départ. (Celui du 8 décembre).
La programmation n'est pas toujours chose simple ... Il faut s'accrocher pour ne pas laisser tomber.
Heureusement que j'avance (lentement mais plus sûrement) sur d'autres parties de mon programme.

J'ai lu attentivement tes propositions, elles me semblent excellentes mais ... je ne suis pas être encore à la hauteur de leurs réalisations ...

1 Mon premier échec (pourtant je pensais franchir l'obstacle facilement).
Je ne parviens pas à stopper l'ouverture multiple de mes fichiers sélectionnés. Je place bien un test du Caption : If (le Caption est "Suivant") Then ???? (Quoi) là je n'ai rien trouvé qui m'arrête ET me permette de repartir en cliquant à nouveau sur Suivant.
En revanche j'ai trouvé les lignes de codes pour ajouter les boutons Réduire et Agrandir dans le haut d'un UserForm. C'est beau, ça fonctionne mais cela ne m'avance guère ...
Ceci dit, l'ouverture de tous les fichiers en même temps ne me gêne pas ... (mais j'aimerais bien y parvenir tout de même, pour comprendre).

2 Mon deuxième échec est toujours le même, lorque j'ai ouvert un fichier(Rappel : du style 13-12-2011-143-MACHIN.xls) avec mon UserForm et ses ListView, j'ai la main pour toutes les actions que je dois mener sur celui-ci (là, rien à automatiser, pas d'impression systématique) MAIS après l'enregistrement de ce fichier, je ne parviens toujours pas à re-basculer sur mon Classeur Principal, celui sur lequel j'ai les feuilles récapitulatives de mes factures encore non payées. Si je minimise le fichier des factures à l'écran avec une ligne de code, je "vois bien" mon Classeur Principal mais "le programme" ne parviens pas à reprendre la main sur celui-ci. Je ne parviens pas à transférer une variable portant le nom de mon Classeur Principal, depuis ce Classeur Principal vers le Code qui s'inscrit "dans mon fichier ouvert", à la création de mes CommandButtons (Enregistrer et Imprimer). En clair, lorsque je regarde mes variables au lancement du code de mon bouton "Enregistrer", je n'ai pas celle portant le nom de mon Classeur Principal)
Cela fait bientôt 5 jours que je tourne en rond et je ne vois pas de sortie ...

3 En ce qui concerne ton conseil de ne pas effacer les fichiers "Payés", tu as raison. Je vais m'orienter dans ce sens même si, aujourd'hui, je n'en suis pas à cet endroit de programmation.

Je ne sais si tu pourras me sortir de tout cela. Si c'est au delà de "mes capacités actuelles de programmation" je verrais à orienter mon programme dans une direction plus "sinueuse". Je pensais pouvoir grimper la falaise directement ... Je vais peut-être être obligé de faire le tour. Il faut savoir quelquefois rester humble.

Merci encore et bonne soirée.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 15/12/2011, 21h07   #12
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

Citation:
je ne parviens toujours pas à re-basculer sur mon Classeur Principal, celui sur lequel j'ai les feuilles récapitulatives de mes factures encore non payées.
As tu des modifications à faire à la main sur ce classeur après avoir traité un fichier facture, qui t'oblige à reprendre la main sur la feuille excel? ou souhaites tu juste retrouver le userForm?


Essai de mettre un fichier démo avec des données bidons, inutile d'avoir 50 lignes de facture 2/3 lignes par rédacteur suffiront amplement, histoire de voir comment s'organise ton fichier

++
Qwaz
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/12/2011, 19h14   #13
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

Merci pour ta patience.

Je te fais donc parvenir un "mini-modèle" de mon programme.
Il se compose du programme principal compressé au format .zip et nommé :
- Modèle programme - 16-12-2011.zip
et de 4 fichiers facture répartis sur les 3 vendeurs. Ces fichiers sont tous de la forme :
- 9-12-2011-50-TOTO.xls

Pour que la recherche des fichiers sur le disque fonctionne, j'ai choisi le premier disque C avec un répertoire et un sous répertoire.

Le programme principal se trouve donc en :
- C:\Mon programme\
Et toutes les factures se trouvent en :
- C:\Mon programme\Factures\

Le Bouton de lancement est sur la feuille "Lancement".

Après le clic sur le bouton, le UserForm6 s'affiche avec la liste des factures pour chacun.
La validation d'un choix provoque l'ouverture de la facture. Je peux refermer le UserForm6.
J'effectue mes modifications et à l'aide du bouton "Enregistrer" j'enregistre à nouveau cette facture (qui, au passage s'enregistre, bien sûr, au format xlsx ... il me faudra modifier cela par la suite). Juste après l'enregistrement le programme bogue sur la ligne de code :

Code :
Sheets("Fact non payées - " & Préparateur).Select
Code qui se trouve dans un module intitulé :

"Nom du fichier" feuil22 (Code)

Je précise que j'ai pris bonne note de tes remarques (éviter les accents, pas de else : ..., utiliser des boucles au lieu de répéter les parties de programme ...). Lorsque "tout fonctionnera à peu près ..." je reprendrais par écrit mes lignes de code pour modifier et essayer d'améliorer mon style de programmation.

Merci encore.

Bon Weekend

Danad38
Fichiers attachés
Type de fichier : xls 14-12-2011-52-AREPASSER.xls (13,1 Ko, 3 affichages)
Type de fichier : xls 15-12-2011-55-IQUE.xls (13,0 Ko, 3 affichages)
Type de fichier : xls 15-12-2011-56-RIEN.xls (13,0 Ko, 3 affichages)
Type de fichier : xls 15-12-2011-58-POURLAVAISSELLE.xls (13,1 Ko, 3 affichages)
Type de fichier : zip Modèle programme - 16-12-2011.zip (122,0 Ko, 3 affichages)
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/12/2011, 19h30   #14
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Qwazerty,

Je constate que je n'ai pas répondu à ta première question.

Une fois mon classeur facture ouvert, j'ai à noter, manuellement le paiement de la facture et le mode de paiement. Il se peut aussi que l'ouverture soit une erreur et que je n'ai rien à écrire ... Ceci serait un cas particulier.

Une fois la modification effectuée, j'enregistre ce classeur Facture avec le même nom et au même endroit, puis, et c'est là mon problème, je dois fermer ce fichier (tout de suite ou plus tard ... ?) et je dois revenir sur mon classeur principal, celui sur lequel se trouvent mes feuilles Factures des vendeurs. Puis j'agis sur les noms de fichiers inscrits sur celle-ci. La recherche de la feuille et du nom de fichier doit s'effectuer de manière automatique.
(Au départ je voulais supprimer la ligne du nom, après ton conseil, je marquerai cette facture comme payée avec le moyen de paiement et de plus je mettrai son écriture en bleu).

En ce qui concerne le UserForm, j'ai deux options. Soit j'ouvre tous les fichiers factures surlignés d'un seul coup, je n'ai donc plus besion de lui et je peux le fermer (Peut-être le plus simple) soit j'ouvre les fichiers les uns après les autres mais dans ce cas il faut systématiquement effectuer la bascule entre : Fichier facture ouvert, Classeur Principal et UserForm ... A priori, cela me semble plus complexe à mettre en oeuvre.

Voilà, j'espère avoir été assez précis.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/12/2011, 19h25   #15
Expert Confirmé Sénior
 
Avatar de Qwazerty
 
Homme Stéphane
La très haute tension :D
Inscription : avril 2002
Messages : 2 446
Détails du profil
Informations personnelles :
Nom : Homme Stéphane
Âge : 32
Localisation : France

Informations professionnelles :
Activité : La très haute tension :D
Secteur : Service public

Informations forums :
Inscription : avril 2002
Messages : 2 446
Points : 4 620
Points : 4 620
Envoyer un message via MSN à Qwazerty
Salut

Alors après avoir vu ton fichier, j'ai changé mon fusil d'épaule.
Si j'ai bien compris, la feuille "Facture - Devis en cours" contenue dans ton classeur Programme sert lors de la génération de tes fichiers Facture.
Dés lors, il faut placer la macro d'enregistrement directement dans cette feuille.
La macro Imprimer est inutile, une fois la zone d'impression défini, elle suivra lors de la copie (au moment de la génération) et elle se redimensionnera toute seule lors de l'insertion de ligne (ajout d'articles).

J'ai aussi rajouté les info RelanceMail et RelanceTel sur la feuille de facture, cette partie étant en dehors de la zone d'impression, elles ne seront jamais imprimées. Elle servent à renseigner le fichier programme lors de l'enregistrement (via le bouton) des classeurs facture.

J'ai ajouté des noms à certaines cellules de ta feuille "Facture - Devis en cours" ("InfoFacturePayee", "RelanceMail", "RelanceTel"), ces noms sont utilisés dans la macro enregistrement, leur présence permet de suivre les cellules contenants ces infos malgré l'ajout de lignes de facturation.

Pour que cela fonctionne, il faut que tu régénères tes fichier facture avec la nouvelle structure de feuille "Facture - Devis en cours", attention à l'extension des fichiers qui doit être .xlsm.

++
Qwaz
Fichiers attachés
Type de fichier : zip Modèle programme - 16-12-2011.zip (116,8 Ko, 6 affichages)
__________________

MagicQwaz := Harry Potter la baguette en moins
Le monde dans lequel on vit
HammerFest
Ma page perso DVP - Dernier Tutoriel : VBA & Internet Explorer
Qwazerty est déconnecté   Envoyer un message privé Réponse avec citation 10
Vieux 19/12/2011, 19h52   #16
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

Merci pour ta réponse et pour le temps passé ...
Ce que tu proposes est une mine de renseignements pour moi !
J'en suis, aujourd'hui, à décortiquer ton code afin de bien comprendre toutes ses finesses. Parallèlement, je l'inclue dans mon programme en adaptant certaines choses (Nom de variables pour avoir les mêmes termes tout au long du programme, chemins, nom des feuilles) et ,bien sûr, ça coince souvent à un moment ou à un autre. Pour l'instant j'ai "surmonté" les problèmes.
Je vais donc continuer.
Je te tiens au courant de l'avancée de mon travail, même si, dans cette période, le temps consacré à la programmation est réduit ...

Merci encore et Joyeux Noël à toi et ceux qui t'entourent.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 05/01/2012, 19h32   #17
Invité régulier
 
Inscription : décembre 2010
Messages : 35
Détails du profil
Informations forums :
Inscription : décembre 2010
Messages : 35
Points : 8
Points : 8
Par défaut Problème avec Activate et Select

Salut Qwazerty,

Après cette longue coupure (Fêtes + Nouvel an au fond du lit ... pour cause de maladie) je reprends mon programme. Je te remercie encore pour ton aide et ta patience. Ce que tu m'as fourni a été capital. J'ai "adapté" car je ne suis pas parvenu à faire fonctionner correctement certains passages mais peu importe, maintenant j'ai résolu mon problème. Je suis donc près à affronter les difficultés suivantes qui ne tarderont pas à venir ...

Je te souhaite une excellente année 2012, une bonne santé et une belle réussite.
Au plaisir de te retrouver sur ce forum.

Danad38
Danad38 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 15h37.


 
 
 
 
Partenaires

Hébergement Web