Dim Cel As Range, MyCol As New Collection, VItem As Integer
'-------------------------------------------------------
'La combobox s'appelle cbChambres (plus facile de savoir de quoi il s'agit
'dans le code lorsque qu'on nomme les contrôles)
'Dans le Frame1 les labels contenant les information de l'occupant de chambre
'ont pour racine de nom 'lb' (lbNom, lbPrenom,lbAge)
'Leur propriété 'tag' contient le numéro de colonne de la feuille BD
'à partir de laquelle l'information sera extraite
'-------------------------------------------------------
Private Sub cbChambres_Click()
Dim ligne As Long 'Ligne de BD
Dim Col As Long 'Colonne
Dim obj As Control
'Si une sélection de chambre a été faite
If cbChambres.ListIndex > -1 Then
'Récupération du numéro de ligne dans la feuille
ligne = 6 + cbChambres.ListIndex
'Chargement des informations dans les labels idoines
For Each obj In frInfos.Controls
'Si les deux premières lettre du nom du contrôle sont lb
'on a affaire à un label information
If Left(obj.Name, 2) = "lb" Then
'Récupère l'information dans BD correspondant à la ligne 'Ligne'
'Et au numéro de colonne contenu dans la propriété 'tag' du label
obj.Caption = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next obj
For Each obj In frPortions.Controls
If Left(obj.Name, 9) = "cbPortion" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frPortions.Controls
For Each obj In frListe_Regime.Controls
If Left(obj.Name, 8) = "cbRegime" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frPortions.Controls
For Each obj In frConsistances.Controls
If Left(obj.Name, 9) = "cbConsist" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frConsitances.Controls
For Each obj In frAllergy.Controls
If Left(obj.Name, 9) = "cbAllergy" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frAllergy.Controls
For Each obj In frAversions.Controls
If Left(obj.Name, 11) = "cbAversions" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frAversions.Controls
For Each obj In frPreferences.Controls
If Left(obj.Name, 13) = "cbPreferences" Then
obj.Text = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next ' obj in frPreferences.Controls
End If
End Sub
Private Sub CommandButton1_Click()
Dim ligne As Long 'Ligne de BD
Dim Col As Long 'Colonne
Dim obj As Control
'Si une sélection de chambre a étée faite
If cbChambres.ListIndex > -1 Then
'Récupération du numéro de ligne dans la feuille
ligne = 6 + cbChambres.ListIndex
'Chargement des informations dans les labels idoines
For Each obj In frInfos.Controls
'Si les deux premières lettre du nom du contrôle sont lb
'on a affaire à un label information
If Left(obj.Name, 2) = "lb" Then
'Récupère l'information dans BD correspondant à la ligne 'Ligne'
'Et au numéro de colonne contenu dans la propriété 'tag' du label
obj.Caption = Sheets("BD").Cells(ligne, Val(obj.Tag)).Text
End If
Next obj
For Each obj In frPortions.Controls
If Left(obj.Name, 9) = "cbPortion" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
For Each obj In frListe_Regime.Controls
If Left(obj.Name, 8) = "cbRegime" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
For Each obj In frConsistances.Controls
If Left(obj.Name, 9) = "cbConsist" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
For Each obj In frAllergy.Controls
If Left(obj.Name, 9) = "cbAllergy" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
For Each obj In frAversions.Controls
If Left(obj.Name, 11) = "cbAversions" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
For Each obj In frPreferences.Controls
If Left(obj.Name, 13) = "cbPreferences" Then
Sheets("BD").Cells(ligne, Val(obj.Tag)).Value = obj.Text
End If
Next
End If
End Sub
Private Sub UserForm_Initialize()
Dim Inc
' Récupérer la liste des AVERSIONS sans ESPACES NI DOUBLONS et la TRIER
Call CreationListe
' Récupérer la liste des Preferences sans ESPACES NI DOUBLONS et la TRIER
Call CreationListe2
'A l'ouverture du userform charger les information dans la combobox
Me.cbChambres.List = Sheets("BD").Range("A6:A" & Sheets("BD").[A65000].End(xlUp).Row).Value
cbPortionMatin.List = Range("Portions").Value
cbPortionMidi.List = Range("Portions").Value
cbPortionSoir.List = Range("Portions").Value
cbRegime1.List = Range("Abrev_Regime").Value
cbRegime2.List = Range("Abrev_Regime").Value
cbRegime3.List = Range("Abrev_Regime").Value
cbRegime4.List = Range("Abrev_Regime").Value
cbConsistmidi.List = Range("Abrév_Consist").Value
cbConsistsoir.List = Range("Abrév_Consist").Value
cbAllergy.List = Range("Notify_Allergy").Value
' Pour chaque Combobox, attribuer la liste des AVERSIONS
For Inc = 1 To 11
Call MaJCombo(Me("cbAversions" & Inc))
Next Inc
' Pour chaque Combobox, attribuer la liste des Préférences
[COLOR="Red"] For Inc = 1 To 13
Call MaJCombo2(Me("cbPreferences" & Inc))
Next Inc[/COLOR]
End Sub
Sub CreationListe()
' Pour chaque cellule de la plage AVERSIONS
For Each Cel In Range("Aversions")
On Error Resume Next
' Si la valeur de la cellule n'est pas vide
' Alors l'ajouter à la collection
If Cel.Value <> "" Then
MyCol.Add Cel.Value, Cel.Value
End If
On Error GoTo 0
Next
' Effectuer le tri dans la collection
Dim I As Integer, J As Integer, Swap1 As String, Swap2 As String
For I = 1 To MyCol.Count - 1
For J = I + 1 To MyCol.Count
If MyCol(I) > MyCol(J) Then
Swap1 = MyCol(I)
Swap2 = MyCol(J)
MyCol.Add Swap1, before:=J
MyCol.Add Swap2, before:=I
MyCol.Remove I + 1
MyCol.Remove J + 1
End If
Next J
Next I
End Sub
[COLOR="red"]Sub CreationListe2()
' Pour chaque cellule de la plage PREFERENCES
For Each Cel In Range("Preferences")
On Error Resume Next
' Si la valeur de la cellule n'est pas vide
' Alors l'ajouter à la collection
If Cel.Value <> "" Then
MyCol2.Add Cel.Value, Cel.Value
End If
On Error GoTo 0
Next
' Effectuer le tri dans la collection
Dim K As Integer, L As Integer, Swap3 As String, Swap4 As String
For K = 1 To MyCol2.Count - 1
For L = K + 1 To MyCol2.Count
If MyCol2(K) > MyCol2(L) Then
Swap3 = MyCol2(K)
Swap4 = MyCol2(L)
MyCol2.Add Swap3, before:=L
MyCol2.Add Swap4, before:=K
MyCol2.Remove K + 1
MyCol2.Remove L + 1
End If
Next L
Next K
End Sub[/COLOR]Sub MaJCombo(CbName As ComboBox)
Dim I As Integer
For I = 1 To MyCol.Count
CbName.AddItem MyCol(I)
Next I
End Sub
[COLOR="red"]Sub MaJCombo2(CbName2 As ComboBox)
Dim K As Integer
For K = 1 To MyCol2.Count
CbName2.AddItem MyCol2(K)
Next K
End Sub[/COLOR]
