lemonegasque
XLDnaute Nouveau
Bonjour,
J'ai vraiment besoin d'aide je suis super bloqué... j'ai repris une application de supermax (merci à ce concepteur) mais aujourd'hui je suis dans la panade car je n'arrive pas à créer de nouvelles colonnes dans ma listbox...
pouvez vous m'aider ??
A ce titre je vous ai joint ma macro, si vous pouvez jeter un oeil voire corriger les imperfections à cause de mon niveau. je vous remercie d'avance.
impossible de mettre mon fichier sur le site dsl
Julien
Private Sub CbB_Machine_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Machine
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 1, VFiltre
' Récupère les valeurs de la liste
MemCombo(1) = VFiltre
Recup_list VFiltre, 1
End With
End Sub
Private Sub CbB_Date_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Date
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 2, VFiltre
' Récupère les valeurs de la liste
MemCombo(2) = VFiltre
Recup_list VFiltre, 2
End With
End Sub
Private Sub CbB_TypeInt_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_TypeInt
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 3, VFiltre
' Récupère les valeurs de la liste
MemCombo(3) = VFiltre
Recup_list VFiltre, 3
End With
End Sub
Private Sub CbB_NomTec_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_NomTec
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 4, VFiltre
' Récupère les valeurs de la liste
MemCombo(4) = VFiltre
Recup_list VFiltre, 4
End With
End Sub
Private Sub CbB_Etat_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Etat
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 5, VFiltre
' Récupère les valeurs de la liste
MemCombo(5) = VFiltre
Recup_list VFiltre, 5
End With
End Sub
Sub FiltrageListe(cListe As Integer, VFiltre As String)
Dim LigLB As Long
For LigLB = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.List(LigLB, cListe - 1) <> VFiltre Then
Me.ListBox1.RemoveItem (LigLB)
End If
Next LigLB
End Sub
Private Sub Ouverture_Historique_Click()
ActiveWorkbook.FollowHyperlink Address:="C:\Users\Maxime\Desktop\Classeur2.xls"
End Sub
Private Sub TextBox4_Change() 'Mise en forme conditionnelle => couleur
If UsF_Modification.TextBox4.Value = "Niveau alerte" Then TextBox4.ForeColor = &HFF&
If UsF_Modification.TextBox4.Value = "Niveau correct" Then TextBox4.ForeColor = &HFF00&
'TextBox4.ForeColor = &H80000008
'TextBox4.ForeColor = &H80000008 '
'End If
End Sub
Private Sub UserForm_Initialize()
' Afficher le formulaire d'INFO
'On Error Resume Next ' Empècher le message d'erreur
' Initialisation des variables
Set Col_Machine = New Collection
Set Col_Date = New Collection
Set Col_TypeInt = New Collection
Set Col_NomTec = New Collection
Set Col_Etat = New Collection
Me.CbB_Machine.Clear
Me.CbB_Date.Clear
Me.CbB_TypeInt.Clear
Me.CbB_NomTec.Clear
Me.ListBox1.Clear
' Mémoriser l'ensemble des cellules remplies, dans un tableau temporaire
With Sheets("INTERVENTIONS")
Derligne = .Range("C" & Rows.Count).End(xlUp).Row
Tabtemp = .Range(.Cells(2, 1), .Cells(Derligne, 10))
End With
With Me.ListBox1 'evite de répéter cette expression devant les Points
.ColumnCount = 10 'on affecte 11 colonnes à la listBox
.ColumnWidths = "00;40;80;70;80;100;80;80;50;50" 'largeurs données aux colonnes
For ligne = 1 To UBound(Tabtemp, 1)
On Error Resume Next
Col_Machine.Add Tabtemp(ligne, 1), CStr(Tabtemp(ligne, 1))
Col_Date.Add Tabtemp(ligne, 2), CStr(Tabtemp(ligne, 2))
Col_TypeInt.Add Tabtemp(ligne, 3), CStr(Tabtemp(ligne, 3))
Col_NomTec.Add Tabtemp(ligne, 4), CStr(Tabtemp(ligne, 4))
Col_Etat.Add Tabtemp(ligne, 5), CStr(Tabtemp(ligne, 5))
On Error GoTo 0
' Inscrire les éléments dans chaque colonne de la ListBox
.AddItem Tabtemp(ligne, 1) ' Machine
Lgn = .ListCount - 1 'on récupère l'index
.List(Lgn, 1) = Tabtemp(ligne, 2) ' Article
.List(Lgn, 2) = Tabtemp(ligne, 3) ' Emplacement stock
.List(Lgn, 3) = Tabtemp(ligne, 4) ' Niveau stock
.List(Lgn, 4) = Tabtemp(ligne, 5) ' Stock
.List(Lgn, 5) = Tabtemp(ligne, 6) ' Seuil reappro
.List(Lgn, 6) = Tabtemp(ligne, 7) ' Délai réappro
.List(Lgn, 7) = Tabtemp(ligne, 8) ' Entrée stock
.List(Lgn, 8) = Tabtemp(ligne, 9) ' Sortie stock
' Inscrire ICI le numéro de la ligne correspondant à l'intervention
.List(Lgn, 9) = 1 + ligne ' Numéro de la ligne
'.List(Lgn, 10) = Tabtemp(ligne, 11) ' test
Next
End With
' Trier les listes ICI
Dim I
Call TriListe(Col_Machine)
For I = 1 To Col_Machine.Count
Me.CbB_Machine.AddItem Col_Machine(I)
Next
Call TriListe(Col_Date)
For I = 1 To Col_Date.Count
Me.CbB_Date.AddItem Col_Date(I)
Next
Call TriListe(Col_TypeInt)
For I = 1 To Col_TypeInt.Count
Me.CbB_TypeInt.AddItem Col_TypeInt(I)
Next
Call TriListe(Col_NomTec)
For I = 1 To Col_NomTec.Count
Me.CbB_NomTec.AddItem Col_NomTec(I)
Next
Call TriListe(Col_Etat)
'
' Fermer le formulaire d'INFO
On Error Resume Next
On Error GoTo 0
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UsF_Modification.Hide
' Récupérer le numéro de la igne de la feuille "INTERVENIONS"
' Ce numéro est inscrit dans la colonne 10 masquée de la liste
LigInt = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)
UsF_Creation.BnEnrModif.Caption = "Modifier"
UsF_Creation.Show
End Sub
Private Sub ListBox1_Click() 'au clic dans la ListBox
For Y = 1 To 9
Me.Controls("TextBox" & Y).Value = ListBox1.List(ListBox1.ListIndex, Y - 1)
Next Y
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Value)
End Sub
J'ai vraiment besoin d'aide je suis super bloqué... j'ai repris une application de supermax (merci à ce concepteur) mais aujourd'hui je suis dans la panade car je n'arrive pas à créer de nouvelles colonnes dans ma listbox...
pouvez vous m'aider ??
A ce titre je vous ai joint ma macro, si vous pouvez jeter un oeil voire corriger les imperfections à cause de mon niveau. je vous remercie d'avance.
impossible de mettre mon fichier sur le site dsl
Julien
Private Sub CbB_Machine_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Machine
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 1, VFiltre
' Récupère les valeurs de la liste
MemCombo(1) = VFiltre
Recup_list VFiltre, 1
End With
End Sub
Private Sub CbB_Date_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Date
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 2, VFiltre
' Récupère les valeurs de la liste
MemCombo(2) = VFiltre
Recup_list VFiltre, 2
End With
End Sub
Private Sub CbB_TypeInt_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_TypeInt
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 3, VFiltre
' Récupère les valeurs de la liste
MemCombo(3) = VFiltre
Recup_list VFiltre, 3
End With
End Sub
Private Sub CbB_NomTec_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_NomTec
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 4, VFiltre
' Récupère les valeurs de la liste
MemCombo(4) = VFiltre
Recup_list VFiltre, 4
End With
End Sub
Private Sub CbB_Etat_Click()
' Empècher l'évènement lors de l'inscription de la valeur
If Pas = True Then Exit Sub
With Me.CbB_Etat
' Récupérer la valeur à filtrer
VFiltre = .Text
' Filtrage de la valeur sélectionnée
' En fait on supprime les lignes non concernée par la valeur
FiltrageListe 5, VFiltre
' Récupère les valeurs de la liste
MemCombo(5) = VFiltre
Recup_list VFiltre, 5
End With
End Sub
Sub FiltrageListe(cListe As Integer, VFiltre As String)
Dim LigLB As Long
For LigLB = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.List(LigLB, cListe - 1) <> VFiltre Then
Me.ListBox1.RemoveItem (LigLB)
End If
Next LigLB
End Sub
Private Sub Ouverture_Historique_Click()
ActiveWorkbook.FollowHyperlink Address:="C:\Users\Maxime\Desktop\Classeur2.xls"
End Sub
Private Sub TextBox4_Change() 'Mise en forme conditionnelle => couleur
If UsF_Modification.TextBox4.Value = "Niveau alerte" Then TextBox4.ForeColor = &HFF&
If UsF_Modification.TextBox4.Value = "Niveau correct" Then TextBox4.ForeColor = &HFF00&
'TextBox4.ForeColor = &H80000008
'TextBox4.ForeColor = &H80000008 '
'End If
End Sub
Private Sub UserForm_Initialize()
' Afficher le formulaire d'INFO
'On Error Resume Next ' Empècher le message d'erreur
' Initialisation des variables
Set Col_Machine = New Collection
Set Col_Date = New Collection
Set Col_TypeInt = New Collection
Set Col_NomTec = New Collection
Set Col_Etat = New Collection
Me.CbB_Machine.Clear
Me.CbB_Date.Clear
Me.CbB_TypeInt.Clear
Me.CbB_NomTec.Clear
Me.ListBox1.Clear
' Mémoriser l'ensemble des cellules remplies, dans un tableau temporaire
With Sheets("INTERVENTIONS")
Derligne = .Range("C" & Rows.Count).End(xlUp).Row
Tabtemp = .Range(.Cells(2, 1), .Cells(Derligne, 10))
End With
With Me.ListBox1 'evite de répéter cette expression devant les Points
.ColumnCount = 10 'on affecte 11 colonnes à la listBox
.ColumnWidths = "00;40;80;70;80;100;80;80;50;50" 'largeurs données aux colonnes
For ligne = 1 To UBound(Tabtemp, 1)
On Error Resume Next
Col_Machine.Add Tabtemp(ligne, 1), CStr(Tabtemp(ligne, 1))
Col_Date.Add Tabtemp(ligne, 2), CStr(Tabtemp(ligne, 2))
Col_TypeInt.Add Tabtemp(ligne, 3), CStr(Tabtemp(ligne, 3))
Col_NomTec.Add Tabtemp(ligne, 4), CStr(Tabtemp(ligne, 4))
Col_Etat.Add Tabtemp(ligne, 5), CStr(Tabtemp(ligne, 5))
On Error GoTo 0
' Inscrire les éléments dans chaque colonne de la ListBox
.AddItem Tabtemp(ligne, 1) ' Machine
Lgn = .ListCount - 1 'on récupère l'index
.List(Lgn, 1) = Tabtemp(ligne, 2) ' Article
.List(Lgn, 2) = Tabtemp(ligne, 3) ' Emplacement stock
.List(Lgn, 3) = Tabtemp(ligne, 4) ' Niveau stock
.List(Lgn, 4) = Tabtemp(ligne, 5) ' Stock
.List(Lgn, 5) = Tabtemp(ligne, 6) ' Seuil reappro
.List(Lgn, 6) = Tabtemp(ligne, 7) ' Délai réappro
.List(Lgn, 7) = Tabtemp(ligne, 8) ' Entrée stock
.List(Lgn, 8) = Tabtemp(ligne, 9) ' Sortie stock
' Inscrire ICI le numéro de la ligne correspondant à l'intervention
.List(Lgn, 9) = 1 + ligne ' Numéro de la ligne
'.List(Lgn, 10) = Tabtemp(ligne, 11) ' test
Next
End With
' Trier les listes ICI
Dim I
Call TriListe(Col_Machine)
For I = 1 To Col_Machine.Count
Me.CbB_Machine.AddItem Col_Machine(I)
Next
Call TriListe(Col_Date)
For I = 1 To Col_Date.Count
Me.CbB_Date.AddItem Col_Date(I)
Next
Call TriListe(Col_TypeInt)
For I = 1 To Col_TypeInt.Count
Me.CbB_TypeInt.AddItem Col_TypeInt(I)
Next
Call TriListe(Col_NomTec)
For I = 1 To Col_NomTec.Count
Me.CbB_NomTec.AddItem Col_NomTec(I)
Next
Call TriListe(Col_Etat)
'
' Fermer le formulaire d'INFO
On Error Resume Next
On Error GoTo 0
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UsF_Modification.Hide
' Récupérer le numéro de la igne de la feuille "INTERVENIONS"
' Ce numéro est inscrit dans la colonne 10 masquée de la liste
LigInt = Me.ListBox1.List(Me.ListBox1.ListIndex, 9)
UsF_Creation.BnEnrModif.Caption = "Modifier"
UsF_Creation.Show
End Sub
Private Sub ListBox1_Click() 'au clic dans la ListBox
For Y = 1 To 9
Me.Controls("TextBox" & Y).Value = ListBox1.List(ListBox1.ListIndex, Y - 1)
Next Y
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Value)
End Sub