[XL-2003] Bouton permettant de passer à la ligne suivante [Résolu]

[zazrun]

Bonjour,

Je souhaiterai faire une macro qui permet de passer à la ligne suivante.

Je m'explique :
J'ai deux feuilles : "clients" et "formulaire"

* dans la feuille "clients" :
ligne 1 = caractéristiques du client 1 (nom, prénom, adresse, tel...)
ligne 2 = caractéristiques du client 2 (nom, prénom, adresse, tel...)
...
ligne 50 = caractéristiques du client 50 (nom, prénom, adresse, tel...)

* dans la feuille "formulaire" :
En A1 : ca reprend le nom et prénom du client 1 <=> [formulaire]A1=[clients!]A1

J'aimerai qu'en cliquant sur le bouton "client suivant" : [formulaire]A1=[clients!]A2

Ensuite j'aimerai qu'en cliquant à nouveau sur le bouton "client suivant" : [formulaire]A1=[clients!]A3 .... et ainsi de suite jusqu'au dernier client.

Est-ce réalisable ??

Pouvez me donner un petit coup de main pour la macro SVP ? Merci.
Xavier

[casefayere]

Bonjour,
Pour commencer, j'imagine qu'il restera du boulot !
code de ton bouton (placé sur feuille formulaire) :

Code :

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
Dim derlg As Integer, plage As Range, x As Integer
derlg = Sheets("clients").Range("A" & Sheets("clients").Rows.Count).End(xlUp).Row
Set plage = Sheets("clients").Range("A1:a" & derlg)
x = plage.Find(Sheets("formulaire").Range("A1")).Row
Sheets("formulaire").Range("A1") = Sheets("clients").Range("A" & x + 1)
End Sub

[zazrun]

Bonjour,

J'ai de nouveau un problème avec ce bouton.
En fait, j'ai répéter le code ci-dessus pour plusieurs caractéristiques (nom prénom, adresse, CP, ville) du client.

(J'imagine qu'il y a plus simple comme code, mais je ne sais pas faire...)

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
Sub ClientSuivant_Clic()
'nom prénom
Dim derlg As Integer, plage As Range, x As Integer
derlg = Sheets("TCD valeurs").Range("B" & Sheets("TCD Valeurs").Rows.Count).End(xlUp).Row
Set plage = Sheets("TCD valeurs").Range("B2:b" & derlg)
x = plage.Find(Sheets("formulaire saisie").Range("B3")).Row
Sheets("formulaire saisie").Range("B3") = Sheets("TCD valeurs").Range("B" & x + 1)
'adresse
Dim derlg1 As Integer, plage1 As Range, y As Integer
derlg1 = Sheets("TCD valeurs").Range("C" & Sheets("TCD Valeurs").Rows.Count).End(xlUp).Row
Set plage1 = Sheets("TCD valeurs").Range("C2:c" & derlg1)
y = plage1.Find(Sheets("formulaire saisie").Range("B4")).Row
Sheets("formulaire saisie").Range("B4") = Sheets("TCD valeurs").Range("C" & y + 1)
'CP
Dim derlg2 As Integer, plage2 As Range, z As Integer
derlg2 = Sheets("TCD valeurs").Range("E" & Sheets("TCD Valeurs").Rows.Count).End(xlUp).Row
Set plage2 = Sheets("TCD valeurs").Range("E2:e" & derlg1)
z = plage2.Find(Sheets("formulaire saisie").Range("B5")).Row
Sheets("formulaire saisie").Range("B5") = Sheets("TCD valeurs").Range("E" & z + 1)
'Ville
Dim derlg3 As Integer, plage3 As Range, a As Integer
derlg3 = Sheets("TCD valeurs").Range("F" & Sheets("TCD Valeurs").Rows.Count).End(xlUp).Row
Set plage3 = Sheets("TCD valeurs").Range("F2:f" & derlg1)
a = plage3.Find(Sheets("formulaire saisie").Range("B6")).Row
Sheets("formulaire saisie").Range("B6") = Sheets("TCD valeurs").Range("F" & a + 1)

Ce code fonctionne correctement, mais si on le répète 7-8 fois (<=> si on clique 7-8 fois sur le bouton "client suivant", il ne fonctionne plus... J'ai beau chercher, et je n'arrive pas à trouver mon erreur. Si quelqu'un peut m'éclairer...

Merci d'avance. Xavier

[BlueMonkey]

Bonjour

Si dans la feuille "Formulaire", les cellules contiennent des formules au format suivant :
[A1] "=TCD valeurs!A1"
[B1] "=TCD valeurs!B1"
[C1] "=TCD valeurs!C1"
...
Et s'il faut passer à :
[A1] "=TCD valeurs!A2"
[B1] "=TCD valeurs!B2"
[C1] "=TCD valeurs!C2"

Le code suivant inséré dans la feuille "Formulaire" devrait convenir.

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
Private Sub AfficheLigneSuivante()
    NextLine(1)
End Sub
 
Private Sub AfficheLignePrecedente()
    NextLine(-1)
End Sub
 
Private Sub NextLine(increment as Integer)
    Dim c As Range
    For Each c In Range(Cells(1, 1), Range("A1").End(xlToRight))
        Call UpdateLine(c, increment)
    Next c
End Sub
 
Sub UpdateLine(r As Range, increment As Integer)
    Dim WsNameSepartorPos As Integer
    WsNameSepartorPos = InStr(1, r.Formula, "!")
 
    Dim rangeEntete As String
    Dim wsName As String
    If (WsNameSepartorPos > 0) Then
         rangeEntete = Mid(r.Formula, 1, WsNameSepartorPos)
         wsName = Mid(r.Formula, 2, WsNameSepartorPos - 2)
     Else
         rangeEntete = "="
         wsName = r.Worksheet.Name
     End If
 
    Dim target As Range
    Set target = Worksheets(wsName).Range(Mid(r.Formula, WsNameSepartorPos + 1))
    With target
        If (.Row + increment) > 0 And _
            (.Row + increment < (.CurrentRegion.Row + .CurrentRegion.Rows.Count)) Then
            r.Formula = rangeEntete & target.Offset(increment).Address
        End If
    End With
End Sub

[mercatog]

Une autre proposition:

J'ai dans la feuille formulaire les formules suivantes:

En B2:

Code :

=clients!A1

En D4:

Code :

=clients!B1

En B7:

Code :

=clients!C1

En F8:

Code :

=clients!D1

Par un bouton, on incrémente la ligne pour retrouver le client suivant et comme option: après le dernier client tu peux repasser au premier.

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
Private Sub CommandButton1_Click()
Dim LastLig As Long
 
With Worksheets("clients")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Worksheets("formulaire")
    .Range("B2").Formula = FrmlNext(.Range("B2").Formula, LastLig)
    .Range("D4").Formula = FrmlNext(.Range("D4").Formula, LastLig)
    .Range("B7").Formula = FrmlNext(.Range("B7").Formula, LastLig)
    .Range("F8").Formula = FrmlNext(.Range("F8").Formula, LastLig)
End With
End Sub
 
Private Function FrmlNext(ByVal Str As String, ByVal Fin As Long) As String
Dim i As Integer, n As Integer, k As Integer
 
n = Len(Str)
If n > 1 Then
    For i = n To 1 Step -1
        If Not IsNumeric(Mid(Str, i, 1)) Then Exit For
    Next i
    k = Val(Mid(Str, i + 1))
    If k = Fin Then k = 0
    FrmlNext = Left(Str, i) & k + 1
End If
End Function

[zazrun]

Merci pour vos réponses BlueMonkey et mercatog.

J'ai opté pour la solution de BlueMonkey, car je l'ai un peu mieux comprise. Et en effet, elle fonctionne. Merci beaucoup.

Dans le même genre, je veux créer un bouton "précédent", j'ai repris le code de Bluemonkey en remplaçant uniquement la fonction FormulNext :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function FrmlNext(ByVal Str As String, ByVal Fin As Long) As String
Dim i As Integer, n As Integer, k As Integer
 
n = Len(Str)
If n > 1 Then
    For i = n To 1 Step -1
        If Not IsNumeric(Mid(Str, i, 1)) Then Exit For
    Next i
    k = Val(Mid(Str, i - 1))
    If k = Fin Then k = 0
    FrmlNext = Left(Str, i) & k - 1
End If
End Function

toutefois ... sans succès! Quelle est la raison ?

[mercatog]

Avec la même fonction (avec un paramètre optionnel à True si on veux trouver le précédent)

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
Private Sub CommandButton1_Click()               'Suivant
Dim LastLig As Long
 
With Worksheets("clients")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Worksheets("formulaire")
    .Range("B2").Formula = FrmlNext(.Range("B2").Formula, LastLig) 'ici sans 3ème paramètres, on avance
    .Range("D4").Formula = FrmlNext(.Range("D4").Formula, LastLig)
    .Range("B7").Formula = FrmlNext(.Range("B7").Formula, LastLig)
    .Range("F8").Formula = FrmlNext(.Range("F8").Formula, LastLig)
End With
End Sub
 
Private Sub CommandButton2_Click()               'Précédent
Dim LastLig As Long
 
With Worksheets("clients")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Worksheets("formulaire")
    .Range("B2").Formula = FrmlNext(.Range("B2").Formula, LastLig, True) 'Ici le 3ème paramètre à True, on recul
    .Range("D4").Formula = FrmlNext(.Range("D4").Formula, LastLig, True)
    .Range("B7").Formula = FrmlNext(.Range("B7").Formula, LastLig, True)
    .Range("F8").Formula = FrmlNext(.Range("F8").Formula, LastLig, True)
End With
End Sub
 
Private Function FrmlNext(ByVal Str As String, ByVal Fin As Long, Optional ByVal Preced As Boolean) As String
Dim i As Integer, n As Integer, k As Integer
 
n = Len(Str)
If n > 1 Then
    For i = n To 1 Step -1
        If Not IsNumeric(Mid(Str, i, 1)) Then Exit For
    Next i
 
    k = Val(Mid(Str, i + 1))
    If Preced Then
        If k = 1 Then k = Fin + 1
    Else
        If k = Fin Then k = 0
    End If
    FrmlNext = Left(Str, i) & k + IIf(Preced, -1, 1)
End If
End Function

[Edit]

La fonction peut être simplifiée comme ceci

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Function FrmlNext(ByVal Str As String, ByVal Fin As Long, Optional ByVal Preced As Boolean) As String
Dim i As Integer, n As Integer, k As Integer
 
n = Len(Str)
If n > 1 Then
    For i = n To 1 Step -1
        If Not IsNumeric(Mid(Str, i, 1)) Then Exit For
    Next i
 
    k = Val(Mid(Str, i + 1))
    k = IIf(Preced, IIf(k = 1, Fin, k - 1), IIf(k = Fin, 1, k + 1))
    FrmlNext = Left(Str, i) & k
End If
End Function

[BlueMonkey]

Re.

Dans la version posté en post#4 pour chercher les lignes précédentes, il faut utiliser la fonction AfficheLignePrecedente().

Le code proposé par Mercatog est basé sur une recherche de ligne à partir de la fin de la formule contenant la plage.
Cette astuce lui permet de ne pas avoir à décoder le nom de l'onglet.

Autre solution pour éviter d'avoir à décoder / encoder la plage ci-dessous.

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
Private Sub AfficheLigneSuivante()
    NextLine (1)
End Sub
 
Private Sub AfficheLignePrecedente()
    NextLine (-1)
End Sub
 
Private Sub NextLine(increment As Integer)
    Dim c As Range
    For Each c In Range(Cells(1, 1), Range("A1").End(xlToRight))
        Call UpdateLine(c, increment)
    Next c
End Sub
 
Sub UpdateLine(r As Range, increment As Integer)
    Dim target As Range
    Set target = Evaluate(r.Formula)
    With target
        If (.Row + increment) > 0 And _
            (.Row + increment < (.CurrentRegion.Row + .CurrentRegion.Rows.Count)) Then
            r.Formula = "=" & .Offset(increment).Address(True, True, xlA1, True)
        End If
    End With
End Sub

[zazrun]

Merci à vous pour votre partage de connaissances ! Super, ça fonctionne avec la formule de Mercatog!!