question sur liaison de 2 listbox

[Kim75]

Bonsoir à tous,

J’ai un registre courrier dont je veux modifier le formulaire, et je ne sais pas comment faire, je veux juste enlever l'étoile qui apparait dans la première Listbox [sociétés], l’idée est que ce soit la première société de la liste qui apparaît au lancement du formulaire et non l’étoile. Il y a deux codes, celui des arrivés recommandé et celui des départs recommandé.


____________________________________________

Code Arrivée Recommandé :

Option Explicit
Dim f, i As Variant, mondico As Object, c As Range, x As Byte

Private Sub CommandButton1_Click()
With Sheets("recom.arr")
.Protect UserInterfaceOnly:=True
i = .Range("k65536").End(xlUp).Row + 1
For x = 1 To 9
.Cells(i, x).Value = Controls("Textbox" & (x)).Value
If x = 9 Then .Cells(i, x).Offset(0, 2).Value = Controls("Textbox" & (x)).Value
Next x
.Cells(i, "I").Value = ComboBox1: .Cells(i, "J").Value = ComboBox2
End With
Unload Me: MsgBox ("l'objet a été enregistré")
End Sub

Private Sub CommandButton2_Click()
Unload arriveerecommande
End Sub

Private Sub CommandButton3_Click()
Dim num As Range, nl As Integer, chnum As Range, x As Integer
With Sheets("recom.arr")
nl = .Range("b" & .Rows.Count).End(xlUp).Row
Set num = .Range("b4:b" & nl)
Set chnum = num.Find(TextBox10)
If Not chnum Is Nothing Then
For x = 1 To 9
Controls("Textbox" & x) = chnum.Offset(0, x - 2)
Next x
ComboBox1.Value = chnum.Offset(0, 7)
ComboBox2.Value = chnum.Offset(0, 8)
End If
End With
End Sub

Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
Me.ComboBox1.AddItem "*"
For Each i In mondico.items
Me.ComboBox1.AddItem i
Next
Me.ComboBox1.ListIndex = 0
TextBox1 = Date
End Sub

Private Sub ComboBox1_Change()
Set f = Sheets("bd")
Me.ComboBox2.Clear
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If c = Me.ComboBox1 Or Me.ComboBox1 = "*" Then
Me.ComboBox2.AddItem c.Offset(0, 1)
End If
Next c
Me.ComboBox2.ListIndex = 0
End Sub
_____________________________________________

Code Départ Recommandé :

Option Explicit
Dim f, i As Variant, mondico As Object, c As Range, x As Long

Private Sub CommandButton1_Click()
With Sheets("recom.dep")
.Protect UserInterfaceOnly:=True
x = .Range("c65536").End(xlUp).Row + 1
For i = 1 To 2: .Cells(x, i) = Controls("Textbox" & i).Value: Next i
For i = 3 To 9: .Cells(x, i).Offset(0, 2) = Controls("Textbox" & i).Value: Next i
.Cells(x, "C") = ComboBox1: .Cells(x, "D") = ComboBox2: End With
Unload Me: MsgBox ("l'objet a été enregistré")
End Sub

Private Sub CommandButton2_Click()
Unload departrecommande
End Sub

Private Sub CommandButton3_Click()
Dim num As Range, nl As Integer, chnum As Range, x As Integer
With Sheets("recom.dep")
nl = .Range("b" & .Rows.Count).End(xlUp).Row
Set num = .Range("b4:b" & nl)
Set chnum = num.Find(TextBox10)
If Not chnum Is Nothing Then
For x = 1 To 9
Controls("Textbox" & x) = chnum.Offset(0, x - 2)
Next x
ComboBox1.Value = chnum.Offset(0, 7)
ComboBox2.Value = chnum.Offset(0, 8)
End If
End With
End Sub

Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
Me.ComboBox1.AddItem "*"
For Each i In mondico.items
Me.ComboBox1.AddItem i
Next
Me.ComboBox1.ListIndex = 0
TextBox1 = Date
End Sub

Private Sub ComboBox1_Change()
Set f = Sheets("bd")
Me.ComboBox2.Clear
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If c = Me.ComboBox1 Or Me.ComboBox1 = "*" Then
Me.ComboBox2.AddItem c.Offset(0, 1)
End If
Next c
Me.ComboBox2.ListIndex = 0
ComboBox2.SetFocus
End Sub

Private Sub ComboBox2_Change()
TextBox3.SetFocus
End Sub
_____________________________________________

Merci, Kim75.

 

[JONEY76]

Re : question sur liaison de 2 listbox

Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
Me.ComboBox1.AddItem ""For Each i In mondico.items
Me.ComboBox1.AddItem i
Next
Me.ComboBox1.ListIndex = 0
TextBox1 = Date
End Sub

 

[JONEY76]

Re : question sur liaison de 2 listbox

Private Sub ComboBox1_Change()
Set f = Sheets("bd")
Me.ComboBox2.Clear
For Each c In f.Range("A1", f.[A65000].End(xlUp))
If c = Me.ComboBox1 Or Me.ComboBox1 = "" Then
Me.ComboBox2.AddItem c.Offset(0, 1)
End If
Next c
Me.ComboBox2.ListIndex = 0
ComboBox2.SetFocus
End Sub








teste comme ça, enleve les etoiles dans le texte

 

[Kim75]

Re : question sur liaison de 2 listbox

Bonsoir Joney 76,

J'ai pensé à cela, mais dans le formulaire il y aura un vide à la place de l'étoile, et en face le nom du 1er collaborateur. Je veux supprimer du code tout ce qui a trait à ce rajout de l'étoile, de sorte qu'au lancement du formulaire, il y aura la 1ere société de la liste qui apparaisse en face du 1er collaborateur.

Merci, Kim75.

 

[kjin]

Re : question sur liaison de 2 listbox

Bonsoir,
Pas vraiment compris où se situe le pb
A remplacer dans les 2 formulaires

Private Sub UserForm_Initialize()
Set mondico = CreateObject("Scripting.Dictionary")
With Sheets("bd")
    For Each c In .Range("A1:A" & .Range("A65000").End(xlUp).Row)
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
    Next c
End With
ComboBox1.List = mondico.items
ComboBox1.ListIndex = 0
TextBox1 = Date

End Sub

Private Sub ComboBox1_Change()
ComboBox2.Clear
With Sheets("Bd")
    For Each c In .Range("A1:A" & .Range("A65000").End(xlUp).Row)
        If c = ComboBox1 Then
            ComboBox2.AddItem c.Offset(0, 1)
        End If
    Next c
End With
ComboBox2.ListIndex = 0

End Sub

A+
kjin

 

[Kim75]

Re : question sur liaison de 2 listbox

Bonsoir kjin,

Merci, mais ça ne fonctionne pas, essaye et tu verras, le fichier est en ligne.

Cdlt, Kim75.

 

[kjin]

Re : question sur liaison de 2 listbox

Bonsoir,
Désolé pour la notation un peu fantaisiste
A+
kjin