C'est une Macro VBA Particulière c'est vrai...

  • Auteur de la discussion Callou
  • Date de début

Callou

Nouveau membre
Salut Forum,

J'utilise un UserForm avec plusieurs TextBox pour renseigner un tableau Excel.
En Bidouillant un peu dans mon code VBa, j'ai reussi à récupérer la valeur des cellules du tableau qui m'interresent dans mes TextBox. Le Hic c'est que je ne peux pas boucler sur la recherche alors si quelqu'un a une idée ...

A +

Voici le Code :

Code:
Private Sub Button_Rechercher_Click()

If UserForm2.Désignation.Text = "" Then
MsgBox "Vous devez saisir une Recherche", vbCritical
End If

Dim x As Long

ActiveSheet.Activate

For x = 4 To Range("A65535").End(xlUp).Row
If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.Désignation.Value) & "*" Then

GoTo Trouve

Exit For

End If

Next x


GoTo Erreur

Exit Sub

Trouve: LigneActive = x

UserForm2.Désignation.Value = ActiveSheet.Cells(LigneActive, "A").Value
UserForm2.Entrée.Value = ActiveSheet.Cells(LigneActive, "D").Value
UserForm2.Puht.Value = ActiveSheet.Cells(LigneActive, "E").Value
UserForm2.Pvte.Value = ActiveSheet.Cells(LigneActive, "G").Value
UserForm2.Dlc.Value = ActiveSheet.Cells(LigneActive, "J").Value
UserForm2.TextBox_Stock.Value = ActiveSheet.Cells(LigneActive, "F").Value
UserForm2.TextBox_Etat.Value = ActiveSheet.Cells(LigneActive, "I").Value
UserForm2.TextBox_Sortie.Value = ActiveSheet.Cells(LigneActive, "H").Value

    Exit Sub



Erreur:  MsgBox ("Requête non trouvée !"), vbRetryCancel + vbExclamation

         
If Response = Retry Then

Désignation.Text = ""
Entrée.Text = ""
Puht.Text = ""
Pvte.Text = ""
Dlc.Text = ""
TextBox_Stock = ""
TextBox_Etat = ""
TextBox_Sortie = ""

      Désignation.SetFocus


 End If

End Sub
 

zeb

Modérateur
Ligne 9: ActiveSheet.Activate
Celle-là, on ne me l'avait encore jamais faite ! lol

--------------------------

Beurk des GoTo !
Tu programmes comme en l'an 1980 !

--------------------------

Bon, je veux bien t'aider, mais à toi de commencer :
Où sont tes TextBox ?
 

Callou

Nouveau membre
Ligne 9: ActiveSheet.Activate
Celle-là, on ne me l'avait encore jamais faite ! lol

--------------------------

Beurk des GoTo !
Tu programmes comme en l'an 1980 !

--------------------------

Bon, je veux bien t'aider, mais à toi de commencer :
Où sont tes TextBox ?


Bonjour Zeb,

Le Prog est pas beau c'est vrai ... mais je débute en VBA depuis environ 1 mois. Pour les années 80 c'est vrai j'ai quelques notions de Basic assez lointaines Nostalgie :lol:

Concernant mon Pb je vais essayé d'être un peu plus clair

Départ sur un UserForm (Userform2)
Et les TextBox :

Désignation (A)
Entrée (D)
Puht (E)
Pvte (G)
Dlc.Value (J)
TextBox_Stock (F)
TextBox_Etat (I)
TextBox_Sortie (H)

A coté des noms TextBox entre () colonnes du tableau Excel concernant les valeurs pour Info

Donc en fait je saisis le mot recherché dans le TextBox "Désignation" puis Click sur le "Bouton Rechercher"
Private Sub Button_Rechercher_Click()

Là, je récupére bien dans les TextBox de l'Userform2 le nom cherché (D'accord ... il déjà tapé ;) ) et ainsi que les valeurs de la ligne correspondante (Puht, Pvte, Dlc etc...)

Mais le hic c'est que j'aurai voulu poursuivre la recherche dans le tableau Excel sur les mots analogues et de surcroît récupérer une fois de plus les valeurs de la ligne de cette proposition dans mes TextBox...

Exemple première recherche :Je tapeCitron
Résultat en TextBox : Citron (Ok c'est déjà tapé en désignation) mais récup. des valeurs Puht, Pvte, Dlc ...

Ensuite je place un Msgbox ("Voulez-vous poursuivre ?"), vbYesNo

et donc je repars du premier mot trouvé au suivant...

Exemple deuxième recherche sur réponse "Yes":

on me propose :

Résultat en TextBox :Tarte Citron + les nouvelles valeurs Puht, Pvte, Dlc ... (Tjrs en textBox)

Et ainsi de suite jusquà revenir à la "première proposition" si il n'y a plus de mot identique.

C'est simple à expliquer, mais je n'ai pas assez de connaissance en VBa :)

En fait c'est Ctrl+F à ceci-près c'est que les valeurs se placent dans des TextBox...

A te lire

A+
 

zeb

Modérateur
Bon alors je reprends ton code en moins 1980 :
Code:
Private Sub Remplir(sh As WorkSheet, ligne As Long)
    UserForm2.Désignation.Value    = sh.Cells(ligne, "A" ).Value
    UserForm2.Entrée.Value         = sh.Cells(ligne, "D" ).Value
    UserForm2.Puht.Value           = sh.Cells(ligne, "E" ).Value
    UserForm2.Pvte.Value           = sh.Cells(ligne, "G" ).Value
    UserForm2.Dlc.Value            = sh.Cells(ligne, "J" ).Value    
    UserForm2.TextBox_Stock.Value  = sh.Cells(ligne, "F" ).Value
    UserForm2.TextBox_Etat.Value   = sh.Cells(ligne, "I" ).Value
    UserForm2.TextBox_Sortie.Value = sh.Cells(ligne, "H" ).Value
End Sub

Private Sub Vider()
    UserForm2.Désignation.Value    = ""
    UserForm2.Entrée.Value         = ""
    UserForm2.Puht.Value           = ""
    UserForm2.Pvte.Value           = ""
    UserForm2.Dlc.Value            = ""    
    UserForm2.TextBox_Stock.Value  = ""
    UserForm2.TextBox_Etat.Value   = ""
    UserForm2.TextBox_Sortie.Value = ""
End Sub

Private Sub Button_Rechercher_Click()
    Dim x As Long
    Dim Found As Boolean
    Dim Reponse As Integer
    
    Found = False

    If UserForm2.Désignation.Text = "" Then
        MsgBox "Vous devez saisir une Recherche", vbCritical
        Exit Sub ' // Sortir ici, c'est pas con, non ?
    End If

    ' ActiveSheet.Activate  // N'importe quoi ! Activer un truc actif
                            // Pourquoi pas ouvrir une porte ouverte.

    For x = 4 To Range("A65535").End(xlUp).Row
        If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.Désignation.Value) & "*" Then
            Found = True
            Remplir ActiveSheet, x
            Exit For
        End If
    Next x
    
    If Not Found Then 
    
        Reponse = MsgBox ("Requête non trouvée !", vbRetryCancel + vbExclamation)
        If Reponse = vbRetry Then
            Vider
            Désignation.SetFocus
        End If
    End If
End Sub

Ligne 32 : Qu'en penses-tu ?
Partout ailleurs : Pas de GoTo ! C'est beaucoup beaucoup mieux. On voit bien les choses !
Et surtout, on voit que pour continuer, il suffit de virer le Exit For de la ligne 42. Ou de le remplacer par un judicieux "On continue ?".
 

Callou

Nouveau membre
Merci Zeb,

C'est un cours Magistral... C'est vrai C+ clair ...
J'ai remplacer X As Long par X As Integer (Pb sur la Réf)
Ligne 42 Ok
Mais comment poursuivre depuis la nouvelle valeur de X à la suivante ?

Msge n°34471:

Mais le hic c'est que j'aurai voulu poursuivre la recherche dans le tableau Excel sur les mots analogues et de surcroît récupérer une fois de plus les valeurs de la ligne de cette proposition dans mes TextBox...

Exemple première recherche :Je tape Citron
Résultat en TextBox : Citron (Ok c'est déjà tapé en désignation) mais récup. des valeurs Puht, Pvte, Dlc ...

Ensuite je place un Msgbox ("Voulez-vous poursuivre ?" ), vbYesNo

et donc je repars du premier mot trouvé au suivant...

A+
 

zeb

Modérateur
Non, x est bien un Long. Puisqu'il peut a priori aller jusqu'à 65536.
C'est donc ma fonction Remplir qu'il faut modifier. Ah bah c'est fait :whistle:

Pour le reste : REFLECHISSEZ !
Vous devez être connecté pour voir les images.


C'est la boucle For qui va t'emmener au suivant !
As-tu essayé de virer le Exit For de la ligne 42, juste pour voir ?
 

Callou

Nouveau membre
Re Zeb,

Pour le reste : REFLECHISSEZ !
A la vue de ma première Procèdure car on peut pas parler de Code
t'es plus fort que moi :lol:

Le Integer à l'air de bien fonctionner ? y'a pas de Bug

C'est la boucle For qui va t'emmener au suivant !
As-tu essayé de virer le Exit For de la ligne 42, juste pour voir ?


Remplacé par MsgBox comme convenu mais après ... ma connaissance dans les fonctions reste limité :(


Code:
For x = 4 To Range("A65535").End(xlUp).Row
        If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.Désignation.Value) & "*" Then
            Found = True
            Remplir ActiveSheet, x
            MsgBox "Poursuivre la recherche ?", vbYesNo
            If vbYes Then
      // ' Là faut Voir ??? car comment indiquer l'adresse de la celulle trouvèe et poursuivre ??
        End If
   End If
      Next x
 

zeb

Modérateur
NON le integer ne fonctionne pas.
Lis l'aide d'Excel, tu verras qu'un integer s'arrête à 32767, donc bien en deça des 65536 lignes d'une feuille Excel. Tu n'as pas 32767 lignes de données. Qu'est-ce que j'en ai à faire : Par principe, les lignes c'est Long.

Pas mal, l'idée du YesNo. Regarde comment lignes 48 et 49 du code précédent je mets le résultat dans une variable et je compare ce résultat à quelque chose de connu.

Pourquoi veux-tu que l'adresse de la cellule ne soit pas connue ? L'adresse de la cellule, c'est "A" & x. Comme x varie avec la boucle For, on poursuit.

Je crois que tu n'as rien compris à ton propre code. Essaye ça :
Code:
For x = 4 To Range("A65535" ).End(xlUp).Row
    MsgBox "Je suis la cellule A" & x"
Next

Tiens, un truc. Et si au lieu de se dire, "Si la réponse est Yes, alors on continue", on écrivait "Si la réponse n'est pas Yes, alors on s'arrête".

"On s'arrête" ça tu sais le faire.
 

Callou

Nouveau membre
RE:
Je crois que tu n'as rien compris à ton propre code. Essaye ça :

C'est vrai j'ai pas toutes "les articulations" du Code VBA en général
mais L'adresse de la cellule, "c'est "A" & x" j'ai bien compris...

mais au vu du Msbox "A & x" je m'aperçois qu'il y a bien un passage sur chaque ligne sans tenir compte de "la valeur" de la la première recherche.

A+ et merci
 

Callou

Nouveau membre
Récupérer la valeur recherché ici "X" et la récupérer en même temps que les autre valeurs de la ligne dans lesTextBox de l'Userform. Mais je n'arrive pas à repartir en recherche sur la nouvelle Occurence.

Normal me direz-vous en regardant le fichier car la saisie "demande" et le "résultat" se font dans le même TextBox donc redondance. Désignation.TextBox

Il faut donc une valeur de comparaision donc une autre TextBox de "Saisie".
Code:
For x = 4 To Range("A65535" ).End(xlUp).Row
        If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.//"ici unTextBox de première Occurence".Value) & "*" Then

Et non pas :

Code:
For x = 4 To Range("A65535" ).End(xlUp).Row
        If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.//Désignation.Value) & "*" Then

Voir + haut les Conditions "Remplir" du Code complet

Et ça fonctionne mieux ...
 

zeb

Modérateur
Bon, moi je ne comprends bien que le code, et je n'avais donc pas bien compris tes explications. Avec ta soluce sous les yeux, je comprends enfin ce que tu voulais dire. Tu as trouvé tout seul, j'en suis ravi. Si en plus, j'ai pu t'aider ... :D
 

Callou

Nouveau membre
Salut Zeb :)

Non seulement tu m'a aidé mais en plus ton code est "Propre". :merci:

En faisant ma première tentative sur le code du début (le miens) j'avais eu un doute ... mais n'avais pas essayé tout de suite de changer de TextBox de Saisie. Mais en regardant ton code bien structuré le doute était confirmé.

Mais je me demande si il existe pas une solution pour "Capter" la valeur "x" première en "tampon" et de récupérer ainsi la seconde occurence, afin de n'utiliser qu'une seule et même TextBox :??:

Si il existe une solution ... :hello:

A+
 

Callou

Nouveau membre
Voir aussi Discussion concernat le Sujet:



Parallèlement à celà un autre souci survient sur une autre partie du

Code:
Private Sub Button_Suivant_Click()
    Dim x As Long
    Dim Found As Boolean
    Dim Reponse As Integer
   
    Button_Rechercher.Visible = False
    Button_Suivant.Visible = True
 
 
    Found = False
 

    For x = 4 To Range("A65535" ).End(xlUp).Row
        If UCase(Range("A" & x)) Like "*" & UCase(UserForm2.TextBox_Nom_Frn.Value) & "*" Then
            Found = True
            Remplir ActiveSheet, x
      // Ici initialement j'avais un MsgBox vbYesNo pour suivre les Occurences, d'après le contenu TextBox_Nom_Frn - Comment obtenir le suivi des Occurences à partir d'un nouveau Click sur le Button_Suivant ? 
        End If
       
      Next x
     
    If Not Found Then
 
Reponse:          MsgBox ("Requête non trouvée !" ), vbRetryCancel + vbExclamation
        If Reponse = Retry Then
            Vider
            TextBox_Nom_Frn.SetFocus
        End If
    End If
End Sub

Merci d'avance
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 131
Messages
6 717 961
Membres
1 586 383
Dernier membre
potofeu
Partager cette page
Haut