boucle IF et For

lio

XLDnaute Occasionnel
Bonjour le forum,

Voila, j'essai péniblement d'adapter une petite application, mais lorsque je clic sur le boutton 'supprimer' (dans un USF), je n'ai rien.
J'ai eu avant ça plusieurs messages d'erreur : il manque 'End If', ou pas de 'For sans Next'.

Je ne comprends plus rien :(

Ci joint le code attaché à ce boutton:

Private Sub supprimer_Click()
Dim Item As Byte
Dim Response As Byte

Col = '129;00;00;00'
For Item = 0 To Listlio.ListCount
If Listlio.ListCount = 0 Then
MsgBox 'Veuillez sélectionner une personne dans la liste', vbInformation: Exit Sub
If Listlio.Selected(Item) = True Then
Response = MsgBox('Les coordonnées de ' & vbCrLf & vbCrLf & _
'Nom : ' & vbTab & lionom & vbCrLf & vbCrLf & _
'Entreprise : ' & vbTab & lioentreprise & vbCrLf & vbCrLf & _
'Equipe : ' & vbTab & lioequipe & vbCrLf & vbCrLf & _
'Qualification : ' & vbTab & lioqualif & vbCrLf & vbCrLf & _
'Vont être définitivement Supprimées ? ', vbCritical + vbOKCancel, 'Attention' & ' SUPPRESSION de : ' & lionom)

If Response = 1 Then
With Worksheets('fiche')
.Rows(Listlio.ListIndex + 2).Delete
End With
misajour Col
MsgBox 'Opération accomplie', vbInformation
Listlio.ListIndex = -1
Me.lionom = ''
Me.lioentreprise = ''
Me.lioequipe = ''
Me.lioqualif = ''
Else: MsgBox 'Opération annulée', vbInformation
End If
End If
End If
Next
End Sub

Merci pour votre aide.
 

Robert

XLDnaute Barbatruc
Bonjour Lio, bonjour le forum,

Je vois que mon idée ne t'as pas enchanté... Tu devais m'en toucher un mot si mes souvenirs sont bons... Arf ! Piégé, loule.

Tel que ton code est écrit il n'agit que si la ListBox Listlio est vide :


For Item = 0 To Listlio.ListCount
If Listlio.ListCount = 0 Then
MsgBox 'Veuillez sélectionner une personne dans la liste', vbInformation: Exit Sub
.... Bla blabla code
.... Bla blabla code
End if 'Juste avant le Next !!!!

Voici ton code modifié et commenté :


Private Sub CommandButton1_Click()
Dim Item As Byte
Dim Response As Byte

Col = '129;00;00;00' 'définit la variable Col

For Item = 0 To Listlio.ListCount 'boucle sur tous les Item de la ListBox 'ListLio'
'condition 1 : si la LitBox 'Listlio est vide
If Listlio.ListCount = 0 Then
MsgBox 'Veuillez sélectionner une personne dans la liste', vbInformation 'message
Exit Sub 'sort de la procédure
End If 'fin de la condition 1

'condition 2 : si il y a un élément sélectionné
If Listlio.Selected(Item) = True Then
'définit la variable réponse
Response = MsgBox('Les coordonnées de ' & vbCrLf & vbCrLf & _
'Nom : ' & vbTab & lionom & vbCrLf & vbCrLf & _
'Entreprise : ' & vbTab & lioentreprise & vbCrLf & vbCrLf & _
'Equipe : ' & vbTab & lioequipe & vbCrLf & vbCrLf & _
'Qualification : ' & vbTab & lioqualif & vbCrLf & vbCrLf & _
'Vont être définitivement Supprimées ? ', vbCritical + vbOKCancel, 'Attention' & ' SUPPRESSION de : ' & lionom)

If Response = 1 Then 'condition 3 : si la réponse est 'Oui' (ou 'Non', je me rapelle plus)
With Worksheets('fiche')
.Rows(Listlio.ListIndex + 2).Delete 'supprime la ligne
End With
misajour Col 'execute une macro
MsgBox 'Opération accomplie', vbInformation 'message
'remise à zéro des contrôles
Listlio.ListIndex = -1
Me.lionom = ''
Me.lioentreprise = ''
Me.lioequipe = ''
Me.lioqualif = ''
Else 'sinon
MsgBox 'Opération annulée', vbInformation 'message
End If 'fin de la condition 3

End If 'fin de la condition 2

Next 'prochain item de ListBox 'Listlio'
End Sub

Édition

Bonjour Pascal, on s'est croisés.


Message édité par: Robert, à: 26/11/2005 16:31
 

lio

XLDnaute Occasionnel
Bonjour Pascal et robert,

Merci pour vos réponses. Je regarde et vous tiens au courant.

PS 1 for Pascal: Je ne reçois plus d'e_mail lorsque je me suis 'abonné' à un sujet. Es ce normal ?

PS 2 for Robert: A vrai dire, je ne me suis pas encore 'plongé' dans ta proposition. Comme promis, je te tiens au courant ce WE.

PS 3: Au pays de la Cigogne en tout cas, pas une Duvel sous le zinc, alors je bois une Dorelei à votre santé.

Merci encore à vous deux et à tous les 'habitués' de ce forum pour ces réponses aussi rapides et complètes.
 

lio

XLDnaute Occasionnel
Re,

Après avoir mis le code de Robert,

je remarque que ce message ne s'affiche pas (quand aucune ligne n'est sélectionnée dans la lisbox):

'Veuillez sélectionner une personne dans la liste'

Si vous avez une idée, n'hésitez pas !

Merci
 

Robert

XLDnaute Barbatruc
Bonsoir Lio, Pascal, bonsoir le forum,

En effet, ce message est renvoyé seulement si Listlio est vide mais pas si aucun item n'est sélectionné. Voici le code modifié :


Private Sub CommandButton1_Click()
Dim Item As Byte
Dim Response As Byte

Col = '129;00;00;00' 'définit la variable Col

'si la LitBox 'Listlio est vide, sort de la procédure
If Listlio.ListCount = 0 Then Exit Sub 'je ne suis pas sûr que cette ligne soit nécéssaire...

For Item = 0 To Listlio.ListCount - 1 'boucle sur tous les Item de la ListBox 'ListLio'

'condition 1 : si l'élément est sélectionné
If Listlio.Selected(Item) = True Then
'définit la variable réponse
Response = MsgBox('Les coordonnées de ' & vbCrLf & vbCrLf & _
'Nom : ' & vbTab & lionom & vbCrLf & vbCrLf & _
'Entreprise : ' & vbTab & lioentreprise & vbCrLf & vbCrLf & _
'Equipe : ' & vbTab & lioequipe & vbCrLf & vbCrLf & _
'Qualification : ' & vbTab & lioqualif & vbCrLf & vbCrLf & _
'Vont être définitivement Supprimées ? ', vbCritical + vbOKCancel, 'Attention' & ' SUPPRESSION de : ' & lionom)

If Response = 1 Then 'condition 2 : si la réponse est 'Oui' (ou 'Non', je me rapelle plus)
With Worksheets('fiche')
.Rows(Listlio.ListIndex + 2).Delete 'supprime la ligne
End With
misajour Col 'execute une macro
MsgBox 'Opération accomplie', vbInformation 'message
'remise à zéro des contrôles
Listlio.ListIndex = -1
Me.lionom = ''
Me.lioentreprise = ''
Me.lioequipe = ''
Me.lioqualif = ''
Exit Sub 'sort de la procédure et évite le message 'Vous devez sélectionner...'
Else 'sinon
MsgBox 'Opération annulée', vbInformation 'message
Exit Sub 'sort de la procédure et évite le message 'Vous devez sélectionner...'
End If 'fin de la condition 2

End If 'fin de la condition 1

Next 'prochain item de ListBox 'Listlio'

'si cette partie du code est lue c'est qu'aucun item n'est sélectionné
MsgBox 'Veuillez sélectionner une personne dans la liste', vbInformation 'message
End Sub
 

PascalXLD

XLDnaute Barbatruc
Modérateur
re

Bon moi il y a un truc que je comprends pas trop

Tu as l'air d'avoir une listbox à choix multiple ce que montre cette ligne :

If Listlio.Selected(Item) = True Then

par contre une fois que tu as supprimé le premier item et bien tu annule toute ta selection

Listlio.ListIndex = -1

Donc pettie question

Dois-tu vraiment avoir une listbox à choix multiple

Si oui pourquoi remettre à zero ?

Si non pourquoi boucler il suffirait de recuperer le listindex ??

Bonne soirée
 

lio

XLDnaute Occasionnel
Bonsoir le fil,

A priori Pascal, je peux effectivement enlever:
Listlio.ListIndex = -1
Me.lionom = ''
Me.lioentreprise = ''
Me.lioequipe = ''
Me.lioqualif = ''

Merci Robert pour ta solution. Seule petite remarque avec ce code j'aurais toujours le message 'Veuillez sélectionner une personne dans la liste'.

Merci à vous, bonne soirée et ...

allez les bleus !
 

Robert

XLDnaute Barbatruc
Bonsoir Lio, Pascal,

Lio, normalement les Exit Sub dans la condition 2 t'évitent le message. D'ailleurs, un seul Exit Sub suffisait, placé entre le End If de la condition 2 et le End If de la condition 1... Mais en dehors de cette petite erreur, ce message ne devrait apparaître que si aucum item n'est sélectionné dans Listlio.
Sinon, il serait bon que tu joingnes ton fichier pour que nous puissions aussi tester nos modifications...
 

lio

XLDnaute Occasionnel
Rebonjour le fil, le forum,

Je m'apperçois que j'ai le même type de problème un peu plus loin
avec encore des messages d'erreur du type 'End If sans IF'.
Ci joint ma macro:


Private Sub CommandButton1_Click()
Dim CTRL As Control 'Variable pour la collection des controls
Dim L As Integer 'Variable pour connaitre le numéro de derniere ligne vide
Dim X As Integer, i As Integer 'Variables pour faire la boucle de checking de Duplication
Dim Response As Byte
Dim Match As Byte

For Each CTRL In Me.Controls
If CTRL = '' Then MsgBox 'Donnée imcomplète', vbCritical, 'Attention': CTRL.SetFocus: Exit Sub
Next CTRL

L = Worksheets('fiche').Range('A65536').End(xlUp).Row + 1 ' On identifie la dernière ligne vide en partant du bas

'ici un Control de Duplication
For X = 2 To L
If TextBox1 = Worksheets('fiche').Range('A' & X) Then
Match = Match + 1: i = X
End If
Next X

'Si il y a Duplication on demande en montrant les détails de la Duplication
If Match > 0 Then
Response = MsgBox('Duplication trouvée dans la base de donnée pour : ' & TextBox1 & vbCrLf & _
'Nom : ' & Worksheets('fiche').Cells(i, 1) & vbCrLf & _
'Entreprise : ' & Worksheets('fiche').Cells(i, 2) & vbCrLf & _
'Equipe : ' & Worksheets('fiche').Cells(i, 3) & vbCrLf & _
'Qualification : ' & Worksheets('fiche').Cells(i, 4) & vbCrLf & _
'Voulez-Vous Intégrer cet enregistrement ?', vbQuestion + vbOKCancel, 'Attention' & ' DUPLICATION ' & TextBox1)

If Response = 1 Then
GoTo Suite
Else: GoTo Fin
End If

Suite: sauvecreation lio 'qui correspond à une macro pour sauvegarder les données dans ma base
Fin:
Unload Me
Col = '129;00;00;00'
misajour Col
personnel.Show' USF
End If
Exit Sub
Else
Ici je voulait mettre si les contrôles (Textbox et combobox) contiennent des infos alors
Response = MsgBox('Les coordonnées de ' & vbCrLf & vbCrLf & _
'Old Nom : ' & vbTab & lionom & vbCrLf & _
'New Nom : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
'Old Entreprise : ' & vbTab & lioentreprise & vbCrLf & _
'New Entreprise : ' & vbTab & TextBox2 & vbCrLf & vbCrLf & _
'Old Equipe : ' & vbTab & lioequipe & vbCrLf & _
'New Equipe : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
'Old Qualification : ' & vbTab & lioqualif & vbCrLf & _
'New Qualification: ' & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
'Acceptez vous ces changements ? ', vbQuestion + vbOKCancel, 'attention' & ' Modification de : ' & lionom)

If Response = 1 Then
sauvecreation lio
MsgBox 'Opération accomplie', vbInformation
Else: MsgBox 'Opération annulée', vbInformation
End If
Unload Me
Col = '129;00;00;00'
misajour Col
personnel.Show
End Sub

Si vous avez une idée, n'hésitez pas.
Merci.

PS: mon fichier zippé fait 85 Ko si besoin j'essaierai de l'alléger au max.
 

lio

XLDnaute Occasionnel
Re,

Je joins mon fichier.

Je suis perdu là !

bonne semaine. [file name=Niark.zip size=35986]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Niark.zip[/file]
 

Pièces jointes

  • Niark.zip
    35.1 KB · Affichages: 23

Robert

XLDnaute Barbatruc
Bonsoir Lio, Pascal, bonsoir le forum,

Je t'avoue que moi aussi je m'y perds un peu... En pièce jointe ton fichier modifié mais je ne suis pas sûr que ce soit cela que tu désires. Attention ! Tu utilises la variable Col dans plusieurs UserForm mais tu ne l'avais pas déclarée publique dans un module. Tu aurais perdu sa valeur à la fermeture de l'Userform... J'ai aussi modifié cela.
[file name=Niark2.zip size=25876]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Niark2.zip[/file]

Édition

Je viens de lire ta réponse sur l'autre fil... Une astuce pour éviter les galères de casse (Majuscule/minuscule) et accepter comme identiques Robert, robert, ROBERT ou RoBerT... Tu mets tout en majuscule et le tour est joué :

If UCase(TextBox1.Value) = UCase(Worksheets('fiche').Range('A' & X)) Then


Message édité par: Robert, à: 28/11/2005 00:29
 

Pièces jointes

  • Niark2.zip
    25.3 KB · Affichages: 26

lio

XLDnaute Occasionnel
Bonjour Robert,

Tout d'abord un grand merci pour ta contribution à mon problème.

Pourquoi ces lignes de code ...
En fait, lorque je clique sur mon bouton 'ajouter' et que j'ai sélectionné la ligne 'lio ' dans ma listbox il s'affiche l'USF 'creation'.
Dès lors, mes 2 textbox et 2 conbobox sont remplies comme ceci:

Lio
XLD
Equipe 1
Débutant

Si j'effectue une modification, par exemple Equipe 5 à la place d'Equipe 1, je souhaiterais avoir un message qui donnerait ceci:

Les coordonnées de

Ancien nom: lio
Nouveau nom: lio
Ancienne entreprise: XLD
Nouvelle entreprise: XLD
Ancienne équipe: Equipe 1
Nouvelle équipe: Equipe 5
Ancienne qualification: débutant
Nouvelle qualification: débutant

Acceptez vous ces modifications ?

oui non

D'où ce code :

Response = MsgBox('Les coordonnées de ' & vbCrLf & vbCrLf & _
'Old Nom : ' & vbTab & lionom & vbCrLf & _
'New Nom : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
'Old Entreprise : ' & vbTab & lioentreprise & vbCrLf & _
'New Entreprise : ' & vbTab & TextBox2 & vbCrLf & vbCrLf & _
'Old Equipe : ' & vbTab & lioequipe & vbCrLf & _
'New Equipe : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
'Old Qualification : ' & vbTab & lioqualif & vbCrLf & _
'New Qualification: ' & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
'Acceptez vous ces changements ? ', vbQuestion + vbOKCancel, 'Lio's information' & ' Modification de : ' & lionom)


C'est assez tordu !. Si tu as une réponse, n'hésite pas.
Quoiqu'il en soit merci pour tout ce que tu as déjà fait.

Bonsoir.
 

Discussions similaires

Statistiques des forums

Discussions
300 793
Messages
1 987 236
Membres
209 746
dernier inscrit
mb1982