Passage d'InputBox à un UserForm.

Version imprimable

Bonjour à tous !
Après avoir créé une macro utilisant plusieurs InputBox et une boucle conditionnelle utilisant les données entrées dans les InputBox, j'ai voulu simplifier la procédure en utilisant un unique UserForm contenant plusieurs TextBox correspondant au champs anciennement renseignés dans mes InputBox.

Seulement voila, ma boucle ne foncionne plus correctement et réagit désormais de façon un peu eratique.

Ma façon de procéder a été la suivante:
J'ai tout d'abord renommé mes textbox
J'ai déclaré mes variables
Puis copié/collé cette macro dans le code UserForm1
Enfin j'ai fais un "Call" vers cette procedure lorsque le Bouton Executer est cliquer.

Voici le code en question:

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
 
 
Private Sub Exécuter_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button Then Call TRIP
    Unload UserForm1
    Sheets("Gestion").Activate
End Sub
 
 
Sub TRIP()
 
     Sheets("Gestion").Activate
     lDerniereLigne = Range("W1").End(xlDown).Address
     lDerniereLigne = Range(lDerniereLigne).Row
 
     For I = 2 To lDerniereLigne
          While Range("S" & I) <> Empty
               Rows(I).Select
               Selection.Delete Shift:=xlUp
          Wend
     Next
 
     Sheets("Projets négo").Activate
 
Dim minkch As Integer
Dim maxkch As Integer
Dim montantexportmin As Long
Dim montantexportmax As Long
Dim montantimportmin As Long
Dim montantimportmax As Long
Dim echeance As Date
Dim Devise2 As String
Dim Devise1 As String
 
     lDerniereLigneReelle = Range("W2").End(xlDown).Address
     lDerniereLigneReelle = Range(lDerniereLigneReelle).Row
 
    Range("A:A,E:E").Replace What:=" ", Replacement:="", LookAt:=xlPart
    Range("A:A,E:E").Replace What:="à", Replacement:="", LookAt:=xlPart
End Sub
 
    For u = 2 To lDerniereLigneReelle
        If Range("A" & u) = UserForm1.Devise1.Text And Range("B" & u) = UserForm1.Devise2.Text Then
            If Range("S" & u) >= UserForm1.minkch.Value _
                And Range("S" & u) <= UserForm1.maxkch.Value _
                And Range("K" & u) <= UserForm1.echeance _
                And UserForm1.montantexportmin.Value >= Range("L" & u).Value _
                And Range("L" & u) <= UserForm1.montantexportmax.Value Then
Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
            End If
          Else
            If UserForm1.Devise1.Text = "" _
                And Range("B" & u) = UserForm1.Devise2.Text Then
                If Range("S" & u) >= UserForm1.minkch.Value _
                    And Range("S" & u) <= UserForm1.maxkch.Value _
                    And Range("K" & u) <= UserForm1.echeance _
                    And Range("L" & u) <= UserForm1.montantexportmax.Value _
                    And Range("L" & u) >= UserForm1.montantexportmin.Value Then
                    Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
                End If
             Else
                If Range("A" & u) = UserForm1.Devise1.Text _
                    And UserForm1.Devise2.Text = "" Then
                    If Range("S" & u) >= UserForm1.minkch.Value _
                        And Range("S" & u) <= UserForm1.maxkch.Value _
                        And Range("K" & u) <= UserForm1.echeance _
                        And Range("L" & u) <= UserForm1.montantexportmax.Value _
                        And Range("L" & u) >= UserForm1.montantexportmin.Value Then
                        Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
                    End If
                  Else
                    If UserForm1.Devise1.Text = "" _
                        And UserForm1.Devise2.Text = "" Then
                        If Range("S" & u) >= UserForm1.minkch.Value _
                            And Range("S" & u) <= UserForm1.maxkch.Value _
                            And UserForm1.montantexportmin >= Range("L" & u) _
                            And Range("L" & u) <= UserForm1.montantexportmax Then
                            Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
                         End If
                    End If
                End If
            End If
        End If
     Next u
 
     Sheets("Gestion").Activate
     With ActiveSheet.UsedRange
          derLi = .Row + .Rows.Count - 1
     End With
     Application.ScreenUpdating = False
     For R = derLi To 1 Step -1
          If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
     Next R
 
     Sheets("Gestion").Activate
End Sub

Merci pour vos futurs éclairages.

Cordialement,

RSoul

27/05/2008, 11h56
ucfoutu

Bonjour,

As-tu pensé à lire ceci :

http://www.developpez.net/forums/sho...d.php?t=553797

Tu peux sans doute éditer ton texte pour t'y conformer... et éviter à ceux qui te lisent des tortocolis, maux de crane, tournis, strabismes etc...;)

Ne confonds pas la balise citation avec la balise code.

Bonjour,

C'est la longueur du code qui rebute un peu ;)
On va essayer d'y aller par étape pour redonner un coup de fraîcheur à tout ça.

1. concernant le code de ton bouton, utilise ceci :
Code:

1 2 3 4 Private Sub Exécuter_Click() Me.Hide = True TRIP End Sub
2. il est préférable de déclarer les variables (toutes les variables) en début de code pour faciliter la lecture
Code:

1 2 3 4 5 6 7 Sub TRIP() Dim minkch As Integer, maxkch As Integer Dim montantexportmin As Long, montantexportmax As Long Dim montantimportmin As Long, montantimportmax As Long Dim echeance As Date, Devise2 As String, Devise1 As String Dim lDerniereLigneReelle As Integer Dim I As Integer, u As Integer
3. Concernant la première partie du code, cela devrait ressembler à ceci
Code:

1 2 3 4 5 6 With Sheets("Gestion") For I = 2 To .Range("W1").End(xlDown).Row If .Range("S" & I) <> "" Then .Rows(I).Delete '<-- si la cellule n'est pas vide, on supprime la ligne complète Next End With
Suite au prochain épisode :)

27/05/2008, 15h06
ouskel'n'or
Ton imbrication de if et de and ne peut être comprise que par l'auteur, d'autant que pour voir si je pouvais t'aider, j'ai dû intenter tout ton code.
Tu as deux boucles. Quel est le problème ? dans quelle boucle ? Quelle ligne soupçonnes-tu ?
Tu as des redondances inutiles. Exemple :
Dans le else de
If UserForm1.Devise1.Text = ""
tu as un autre
If UserForm1.Devise1.Text = ""
etc.
Par ailleurs, tu traites

Code:

If UserForm1.Devise1.Text = ""

après
Code:

1 2 If Range("A" & u) = UserForm1.Devise1.Text _ And Range("B" & u) = UserForm1.Devise2.Text Then
La logique voudrait que tu fasses l'inverse
Bref, simplifie ton code en rassemblant ce qui est à rassembler.
Ensuite, à la place de If, pourquoi n'utilises-tu pas Select case
Code:

1 2 3 4 5 6 7 8 9 Select case Me.Devise1.Text Case "" Case Range("A" & u) if Range("B" & u) = Range("B" & u) Then .... Case ..... Case else End select
etc.
Bon courage

Après Prise en compte de vos conseils:

J'ai essayer de clarifier un petit peu mon codes en ajoutant qques com.
Ne connaisant pas la manip de "Case" je prefere me contenter pour l'instant de la fonction IF, si vs pensez que case serait mieux adaptés à mon cas je my mettrais!

En attendant de profiter de vos éclairages bonne aprem!!

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
 
Private Sub Exécuter_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.Hide = True 'j'ai testé ce private sub mais le mess d'erreur suivant apparait:" erreur de compilation: Affectation à une constante non autorisée"
TRIP
End Sub
 
Sub TRIP()
'déclaration de mes var
Dim minkch As Integer, maxkch As Integer '<---minkch= coef de chance le plus petit que l'on souhaite, Max =le plus gran
Dim montantexportmin As Long, montantexportmax As Long '<---montantexportmin= montant min  et montant max pour montantexportmax
Dim echeance As Date, Devise2 As String, Devise1 As String '<---- echeance =date max que l'on souhaite//Devise1= 1ere devise du projet et Devise2=2ieme devis
Dim lDerniereLigneReelle As Integer
Dim I As Integer, u As Integer '<---I et u = compteurs
 
 
'je commence par "nettoyer" ma feuille "Gestion" des données précedentes en concervant l'entete.
With Sheets("Gestion")
For I = 2 To .Range("W1").End(xlDown).Row
If .Range("S" & I) <> "" Then .Rows(I).Delete
Next
End With
 
' Maintenant le but est d'utiliser un Userform ( le "Userform1" en locurence) afin de faire un tri parmi tous le projets qui se trouvent dans "Projets négos" et en fonction des données entrées dans mon Userform1, les lignes correspondant chacune a un projet sont exportées da la feuille "Gestion"
With Sheets("Projets négo")
 
'Parametrage de mon compteur
lDerniereLigneReelle = Range("W2").End(xlDown).Address
lDerniereLigneReelle = Range(lDerniereLigneReelle).Row
 
 
'
For u = 2 To lDerniereLigneReelle
   If Range("A" & u) = UserForm1.Devise1.Text And Range("B" & u) = UserForm1.Devise2.Text Then ' si dans l'userform, l'utilisateur renseigne les 2 devises qu'il recherche alors on peut passer à la suite;
        If Range("S" & u) >= UserForm1.minkch.Value And Range("S" & u) <= UserForm1.maxkch.Value And Range("K" & u) <= UserForm1.echeance And UserForm1.montantexportmin.Value >= Range("L" & u).Value And Range("L" & u) <= UserForm1.montantexportmax.Value Then  ' si parmi les projets dont les devises correspondent à celle renseignées plus tot, le KCH est compris entre le minkch(au choix de l'utlisateur mais minimum=0) et la maxkcx (au choix de l'utilisateur mais max=100), et si le date des projets est ineferieure à la date entrée par l'utilisateur et en si la somme est sup a montantexportmin et inf a montantexportmax alors:
        Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow 'la ligne est copiée
        End If
    Else 'ou
        If UserForm1.Devise1.Text = "" And Range("B" & u) = UserForm1.Devise2.Text Then ' si l'user décide de ne renseigner qu'un des 2 champs de devises alors la la procédure doit etre semblale à la precedente, sauf que tous les projets ayant la devise2 entrée par le user devront cette fois ci etre selectionnés
            If Range("S" & u) >= UserForm1.minkch.Value And Range("S" & u) <= UserForm1.maxkch.Value And Range("K" & u) <= UserForm1.echeance And Range("L" & u) <= UserForm1.montantexportmax.Value And Range("L" & u) >= UserForm1.montantexportmin.Value Then
            Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow ' et donc copié dans"Gestion"
            End If
        Else
            If Range("A" & u) = UserForm1.Devise1.Text And UserForm1.Devise2.Text = "" Then 'idem a l'etape precedente, sauf que cette fois ci on envisage le cas ou le user a renseigné la 1ere devise et pas la seconde
                If Range("S" & u) >= UserForm1.minkch.Value And Range("S" & u) <= UserForm1.maxkch.Value And Range("K" & u) <= UserForm1.echeance And Range("L" & u) <= UserForm1.montantexportmax.Value And Range("L" & u) >= UserForm1.montantexportmin.Value Then
                Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
                End If
            Else
                If UserForm1.Devise1.Text = "" And UserForm1.Devise2.Text = "" Then ' enfin dans le cas ou le user n'aurait renseigné aucune des devises les projets respectant les conditions suivantes seront selectionnés.
                    If Range("S" & u) >= UserForm1.minkch.Value And Range("S" & u) <= UserForm1.maxkch.Value And UserForm1.montantexportmin >= Range("L" & u) And Range("L" & u) <= UserForm1.montantexportmax Then
                    Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow
                    End If
                End If
           End If
         End If
    End If
Next u
 
 
' le process suivant vise à remonter ttes les ligne et a suprmer les blanc
 
Sheets("Gestion").Activate
With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For R = derLi To 1 Step -1
If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
 
 Sheets("Gestion").Activate
End Sub

27/05/2008, 18h01
fring
oups sorry, j'ai fait une boulette ici
Code:

1 2 3 4 Private Sub Exécuter_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.Hide '<-- il faut supprimer = True TRIP End Sub
Mais pourquoi utiliser l'évènement MouseUp du bouton ?

et en fin de procédure TRIP, tu ajoutes ceci
Code:

1 2 Unload UserForm1 End Sub
ce qui aura pour effet de vider ton UserForm

Dis nous où tu en es avec ces premières modifs, ça fonctionne ? ça coince ?
27/05/2008, 18h36
rsoul

Ou en suis-je??

Alors après avoir testé les modifs que vous me suggeriez, j'ai constaté que:
ma macro bug depuis que j'ai declaré
lDerniereLigneReelle
et
qu'un End With manquait depuis que j'ai remplacé Sheets("Gestion").Activate par
With("Gestion")

Je suis donc revenu en arriere

Mon principal pb et pour l'instant le suivant:
Lorsque je rentre comme KCH min 0 ou 1 et en max 100 et bien lles projets selectionner on ts un KCH de 1 ou 10.
Je pense que cela vient du type de variable declaré au début!

Merci par avance et a très (très) vite
27/05/2008, 19h08
fring
Quelques mots d'explication

Citation:

Alors après avoir testé les modifs que vous me suggeriez, j'ai constaté que:
ma macro bug depuis que j'ai declaré lDerniereLigneReelle

C'est normal parce que tu change le type de ta variable en cours d'exécution, tu l'utilises d'abord comme un String et ensuite comme un Integer.
Tu peux te passer de cette variable et écrire le code de cette manière

Code:

For u = 2 To Range("W2").End(xlDown).Row

Autre conseil, pour être certain de trouver la dernière ligne (au cas où il y aurait des lignes vides dans la colonne), il vaut mieux faire la vérification du bas vers le haut, comme ceci :

Code:

For u = 2 To Range("W65535").End(xlUp).Row

Citation:

et qu'un End With manquait depuis que j'ai remplacé Sheets("Gestion").Activate par With("Gestion")

Regarde dans cette partie comment j'ai utilisé le With...End With
Code:

1 2 3 4 5 With Sheets("Gestion") For I = 2 To .Range("W1").End(xlDown).Row If .Range("S" & I) <> "" Then .Rows(I).Delete Next End With
Citation:

Je suis donc revenu en arriere

solution de facilité...:p

Citation:

Mon principal pb et pour l'instant le suivant:
Lorsque je rentre comme KCH min 0 ou 1 et en max 100 et bien lles projets selectionner on ts un KCH de 1 ou 10.
Je pense que cela vient du type de variable declaré au début!

Là...je n'ai pas la patience d'éplucher ton code avec tes innombrables If...

Je recentre le débat

Alors je vais prendre mes petits soucis un par un:

Un de mes principaux problèmes est dans une de mes boucles, la suivante;
Code:

1 2 3 4 5 6 Dim minkch As Integer, maxkch As Integer If Range("S" & u) >= UserForm1.minkch.Value And Range("S" & u) <= UserForm1.maxkch.Value Then Rows(u).Copy Destination:=Worksheets("Gestion").Rows(u).EntireRow End If
Sachant que minkch est un chiffre = à 0 et maxkch=100 et ces données sont fixes.
Ce qui change c'est le contenu des cellules de la colonne S, qui est lui aussi un chiffre compris entre 0 et 100.

Mon problème est que lorsque je suis en mode débogage, et que je met un Stop sur ces lignes; cela m'indique que Range("S" & u)= 60 (par exemple) et que Range("S" & u) >= UserForm1.minkch.Value = Vrai avec UserForm1.minkch.Value = 0 (en effet 60>=0)
Mais lorsque je me met sur Range("S" & u) <= UserForm1.maxkch.Value, j'obtiens Range("S" & u)=60 (jusque la :ok)
UserForm1.maxkch.Value=100 (ok aussi)
Mais Range("S" & u) <= UserForm1.maxkch.Value=Faux (Comprends pas là, 60<=100 non??!)

Merci pour votre aide a venir!:lol:

29/05/2008, 12h42
ouskel'n'or

Citation:

Comprends pas là, 60<=100 non

Si, enfin, je crois :mouarf:
Bref, je suis comme toi, dans l'expectative :(
Teste en mettant

Code:

If Range("S" & u).value

dans ton code
29/05/2008, 15h13
rsoul
Et bien je viens de tenter d'ajouter.value mais malheureusement le résultat est le même....
Toujours dans l'attente de vos conseilssss, bonne aprem!

En fait j'ai comme l'impression que VBA pren mon 100 pour un 10 ou 1 en effet si pour tester j'inverse le signe
Code:

1 2 Range("S" & u).Value >= UserForm1.maxkch.Value
La il me dit que"60>=100=Vrai"....

Avez vous deja rencontré ce problème??

Peut être mes var sont elle mal declarées?

PLease Help!!
29/05/2008, 15h33
ouskel'n'or
Dernière tentative : Analyse par petits bouts
Code:

1 2 Msgbox Range("S" & u) >= UserForm1.minkch.Value Msgbox Range("S" & u) <= UserForm1.maxkch.Value
Juste une remarque : Je n'ai jamais vu VBA se tromper dans ses évaluations. C'est toujours une erreur tellement bête qu'on ne la voit pas ;)
Tu dis
A+
30/05/2008, 05h26
AlainTech

Il faut éviter de comparer des pommes et des poires.

Dans une cellule, un nombre est un nombre alors que dans une TextBox il ne peut y avoir que du texte.

VBA "essaye" de "deviner" ce qu'on cherche à faire et... se trompe.

En transformant le texte en nombre

Code:

Range("S" & u) <= Val(UserForm1.maxkch.Value) Then

plus d'ambigüité possible.
30/05/2008, 17h38
rsoul

Merci

Excellent cela foncitonne, c'est formidable ce val()!
Merci encore!