Discussion :

[pascalcom]

Bonjour,
Cela fait un moment que je tourne en rond tout comme ma boucle FOR.
Je cherche à trouver des valeurs dans un tableau et une fois repérées je copie des éléments de sa ligne sur une feuille et j'imprime.
J'utilise la boucle for pour lire une par une les lignes de mon tableau.
Je trouve bien ma première valeur et la feuille s'imprime mais une erreur se produit lors de recherche de prochaine sauf si celle ci se trouve en dernière ligne.

Cela coince sur ligne 63 : ligne = celluletrouvee.Row.

Erreur d'exécution 91:
Variable objet ou variable de bloc With non définie

Auriez-vous une idée de mon problème?
Merci pour votre aide
Pascal

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
Sub test_impression()
''''''''''''''''''''''''''''
'impression d'un groupe GR de fiche
'
''''''''''''''''''''''''''''
 
Application.ScreenUpdating = False
 
'Call DEpro
 
Dim marecherche As String 'VAR VALEUR DE LA RECHERCHE
Dim celluletrouvee As Range 'VAR ADRESS DE LA CELLULE
Dim ligne As Integer
Dim col As Integer
Dim ligneordre As Integer '
 
' Variables fiche
Dim CHAMPS1 As String 'NOM
Dim CHAMPS2 As String 'PRENOM
Dim CHAMPS3 As String 'SEXE
Dim CHAMPS4 As Integer 'AGE
Dim CHAMPS5 As Integer 'POIDS
Dim CHAMPS6 As Integer 'TAILLE
 
Dim CHAMPS8 As String 'ETAB
Dim CHAMPS9 As String 'GR
 
 
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Dim derlig As Integer 'NBE LIGNES non blanches
Dim rechercheGr As String
 
'''''''''''''''''''
'condition de recherche
 
Sheets("MENU").Select ' OUVRE  "MENU"
rechercheGr = Range("G19") ' CHARGE LA valeur à RECHECHER DANS RECHERCHE sur BASE colonne K
     If rechercheGr = "TOUT" Then
        'call impressionTOUT
        'Range("G19") = ""
     Else
         If rechercheGr <> "" Then
            marecherche = rechercheGr
            'Range("G19") = ""
         Else
            MsgBox "Aucune saisie n'a été faite!"
            Exit Sub
         End If
     End If
 
'''''''''''''''''''
'recherche
''''''''''''''''''''''''''''''''''''''''''''''
 
Sheets("BASE").Activate
derlig = Range("C1000").End(xlUp).Row 'cherche la derniere ligne en C SUR COLONNE NOM
 
For ligneordre = 3 To derlig ' On boucle jusqu'à la derniere ligne non blanche en NOM "C"
 
            'Set celluletrouvee = Range("k" & ligneordre & ":k1000").Find(marecherche, lookat:=xlWhole) 'PLAGE DE RECHERCHE EN K3:K1000
            Set celluletrouvee = Range("k3:k1000").Find(marecherche, lookat:=xlWhole) 'PLAGE DE RECHERCHE EN K3:K1000
 
                ligne = celluletrouvee.Row
                col = celluletrouvee.Column
                ligneordre = ligne
'''''''''''''''''''''''''''''''''''''''''''''''''''
''''PERSO
CHAMPS1 = Cells(ligne, 3) ' NOM
CHAMPS2 = Cells(ligne, 4) ' PRENOM
CHAMPS3 = Cells(ligne, 5) ' SEXE
CHAMPS4 = Cells(ligne, 6) ' AGE
CHAMPS5 = Cells(ligne, 8) ' POIDS
CHAMPS6 = Cells(ligne, 9) ' TAILLE
 
''ETAB
CHAMPS8 = Cells(ligne, 10) ' ETAB
CHAMPS9 = Cells(ligne, 11) ' GR
 
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'' On affiche les données DANS FICHES
 
Sheets("FICHES").Select
Range("A1").Select
'ActiveWindow.ScrollRow = Selection.Row
 
'Range("D4") = marecherche
''''PERSO
Range("D6") = CHAMPS1 'NOM
Range("G6") = CHAMPS2 'PRENOM
Range("D8") = CHAMPS3 'SEXE
Range("G8") = CHAMPS4 'AGE
Range("D10") = CHAMPS5 'POIDS
Range("G10") = CHAMPS6 'TAILLE
''ETAB
Range("D15") = CHAMPS8 'ETAB
Range("G15") = CHAMPS9 'GROUPE
 
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
 
    Range("B3:I37").Select
    ActiveSheet.PageSetup.PrintArea = "B3:I37" 'zone impression
'    'j'imprime
 
' ThisWorkbook.PrintOut
ThisWorkbook.PrintPreview
 
Next
Sheets("MENU").Select ' OUVRE  "MENU"
End Sub

[Invité]

Bonjour,

Une autre solution possible :

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
 
Sub Test_Impression()
 
'impression d'un groupe GR de fiche
 
       ' Application.ScreenUpdating = False
 
        With Sheets("MENU") 
 
             Select Case .Range("G19") ' CHARGE LA valeur à RECHECHER DANS RECHERCHE sur BASE colonne K
                    Case "TOUT"
                         'call impressionTOUT
                         'MsgBox .Range("G19")
                    Case Is <> ""
                         RechercheEtImpressionGroupe .Range("G19"), Sheets("BASE"), Sheets("FICHES")
                         .Range("G19") = ""
                    Case ""
                         MsgBox "Aucune saisie n'a été faite !", vbCritical, "Impression d'un groupe GR"
                         Exit Sub
             End Select
        End With
       ' Application.ScreenUpdating = True
 
 
End Sub
 
Sub RechercheEtImpressionGroupe(ByVal ChaineARechercher As String, ByVal ShBase As Worksheet, ByVal ShFiches As Worksheet)
 
Dim AireRecherche As Range
Dim DerniereLigne As Long, I As Long
Dim ColNom As Long, ColPrenom As Long, ColSexe As Long, ColAge As Long, ColPoids As Long, ColTaille As Long, ColEtab As Long, ColGr As Long
 
        With ShBase
 
           ColNom = 3: ColPrenom = 4: ColSexe = 5: ColAge = 6: ColPoids = 8: ColTaille = 9: ColEtab = 10: ColGr = 11
           DerniereLigne = .Range("C1000").End(xlUp).Row
 
           If DerniereLigne < 3 Then Exit Sub
 
           Set AireRecherche = .Range(.Cells(3, ColGr), .Cells(DerniereLigne, ColGr))
 
 
           For I = 1 To AireRecherche.Count
               If AireRecherche(I) = ChaineARechercher Then
                  With ShFiches
 
                        .Range("D6") = AireRecherche(I).Offset(0, ColNom - ColGr)
                        .Range("G6") = AireRecherche(I).Offset(0, ColPrenom - ColGr)
                        .Range("D8") = AireRecherche(I).Offset(0, ColSexe - ColGr)
                        .Range("G8") = AireRecherche(I).Offset(0, ColAge - ColGr)
                        .Range("D10") = AireRecherche(I).Offset(0, ColPoids - ColGr)
                        .Range("G10") = AireRecherche(I).Offset(0, ColTaille - ColGr)
                        .Range("D15") = AireRecherche(I).Offset(0, ColEtab - ColGr)
                        .Range("G15") = AireRecherche(I)
 
                        .PageSetup.PrintArea = "B3:I37" 'zone impression
                        ThisWorkbook.PrintPreview
 
                  End With
               End If
           Next I
 
           Set AireRecherche = Nothing
 
        End With
 
End Sub

[pascalcom]

Merci Eric,
Je vais reprendre tout cela a tête reposée.
Pascal

[pascalcom]

Bonsoir Eric,
C'est plus qu'une solution, c'est tout à fait PARFAIT.
c'est tout un programme pour moi maintenant! Ton analyse rationnelle de mon problème me ravit et va m'obliger à décortiquer ton code pour comprendre.
Un grand merci pour ton aide.
Au plaisir de pouvoir en discuter.
Amicalement,
Pascal