Bonjour,
J'aurais besoin de vos lumières pour réaliser un code VBA.
Ce que je souhaite réaliser, c'est un fichier Excel qui va servir de petite base de données. Une ligne par enregistrement, et pour chaque enregistrement, diverses colonnes à renseigner (bref, standard quoi).
Mais pour éviter les erreurs de saisies, je souhaiterais proposer pour certaines colonnes des choix prédéfinis. Par exemple pour la colonne A, l'utilisateur pourrait rentrer "abricot; pomme; poire", et dans la colonne B, il aurait le choix entre "jambon; fromage; pain".
Tout ceci serait bien entendu facilement réalisable à l'aide de la fonction "validation des données", toutefois, celle-ci ne répond pas entièrement à mes besoins...Et c'est là que ça se complique. Je souhaiterais pouvoir réaliser les arguments suivants:
- l'utilisateur peut faire une sélection multiple
- Et donc par exemple s'il sélectionne "abricot" et "pomme" pour l'enregistrement 18 (donc cellule A18), il s'agirait que ces 2 arguments apparaissent l'un dessous l'autre DANS LA MÊME CELLULE.
Jusque là, j'ai trouvé un code qui permet de faire ceci, mais partiellement. Mon gros problème réside dans le fait que l'on ne peut pas appliquer ce code à l'ensemble des cellules d'une même colonne aussi facilement qu'avec la "validation des données" (copier -> collage spécial -> validation). Par ailleurs, je ne suis pas assez averti pour savoir comment faire pour que cette même page puisse également gérer une deuxième listbox pour la colonne B (c.f. ci-dessus).
Ci-dessous, un exemple de code trouvé sur internet qui permet de faire ce que je veux, mais sur UNE SEULE CELLULE d'une même colonne (cell B1), et qui NE TIENT PAS COMPTE D'UNE 2è LISTBOX pour une autre colonne:
Option Explicit
Private WithEvents Lbx As MSForms.ListBox
Private oTarget As Range
Private sListBoxName As String
Private Const Cell_A1 As String = "b1" 'change addr as required.
Private Sub Lbx_Change()
Dim i As Long
oTarget.ClearContents
For i = 0 To Lbx.ListCount - 1
If Lbx.Selected(i) Then
If Len(oTarget) = 0 Then
oTarget = Lbx.List(i)
Else
oTarget = _
Trim(oTarget & vbNewLine & Lbx.List(i))
End If
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oListBox As OLEObject
On Error Resume Next
Me.OLEObjects(1).Delete
If UCase(Target.Address(0, 0)) = UCase(Cell_A1) Then
Application.DisplayFormulaBar = False
Set oListBox = _
Me.OLEObjects.Add(ClassType:="Forms.ListBox.1")
With oListBox
Names.Add "ListBoxName", .Name
.Left = Target.Offset(1, 1).Left
.Top = Target.Offset(2, 2).Top
.Width = Me.StandardWidth * 10
.Height = Me.StandardHeight * 10
.ListFillRange = Sheets(2).Name & "!a1:a20"
.Placement = xlFreeFloating
.Object.MultiSelect = fmMultiSelectMulti
With Application
.OnTime Now + _
TimeSerial(0, 0, 0.01), Me.CodeName & ".Hooklistbox"
.CommandBars.FindControl(ID:=1605).Execute
End With
End With
Else
Application.DisplayFormulaBar = True
Names("ListBoxName").Delete
Range(Cell_A1).Interior.ColorIndex = 0
End If
End Sub
Private Sub Hooklistbox()
Application.CommandBars.FindControl(ID:=1605).Reset
Set oTarget = ActiveCell
ActiveCell.Interior.Color = vbYellow
'display the listbox and hook it.
With Me.OLEObjects(Evaluate("ListBoxName"))
.Visible = True
Set Lbx = .Object
End With
End Sub
J'aurais besoin de vos lumières pour réaliser un code VBA.
Ce que je souhaite réaliser, c'est un fichier Excel qui va servir de petite base de données. Une ligne par enregistrement, et pour chaque enregistrement, diverses colonnes à renseigner (bref, standard quoi).
Mais pour éviter les erreurs de saisies, je souhaiterais proposer pour certaines colonnes des choix prédéfinis. Par exemple pour la colonne A, l'utilisateur pourrait rentrer "abricot; pomme; poire", et dans la colonne B, il aurait le choix entre "jambon; fromage; pain".
Tout ceci serait bien entendu facilement réalisable à l'aide de la fonction "validation des données", toutefois, celle-ci ne répond pas entièrement à mes besoins...Et c'est là que ça se complique. Je souhaiterais pouvoir réaliser les arguments suivants:
- l'utilisateur peut faire une sélection multiple
- Et donc par exemple s'il sélectionne "abricot" et "pomme" pour l'enregistrement 18 (donc cellule A18), il s'agirait que ces 2 arguments apparaissent l'un dessous l'autre DANS LA MÊME CELLULE.
Jusque là, j'ai trouvé un code qui permet de faire ceci, mais partiellement. Mon gros problème réside dans le fait que l'on ne peut pas appliquer ce code à l'ensemble des cellules d'une même colonne aussi facilement qu'avec la "validation des données" (copier -> collage spécial -> validation). Par ailleurs, je ne suis pas assez averti pour savoir comment faire pour que cette même page puisse également gérer une deuxième listbox pour la colonne B (c.f. ci-dessus).
Ci-dessous, un exemple de code trouvé sur internet qui permet de faire ce que je veux, mais sur UNE SEULE CELLULE d'une même colonne (cell B1), et qui NE TIENT PAS COMPTE D'UNE 2è LISTBOX pour une autre colonne:
Option Explicit
Private WithEvents Lbx As MSForms.ListBox
Private oTarget As Range
Private sListBoxName As String
Private Const Cell_A1 As String = "b1" 'change addr as required.
Private Sub Lbx_Change()
Dim i As Long
oTarget.ClearContents
For i = 0 To Lbx.ListCount - 1
If Lbx.Selected(i) Then
If Len(oTarget) = 0 Then
oTarget = Lbx.List(i)
Else
oTarget = _
Trim(oTarget & vbNewLine & Lbx.List(i))
End If
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oListBox As OLEObject
On Error Resume Next
Me.OLEObjects(1).Delete
If UCase(Target.Address(0, 0)) = UCase(Cell_A1) Then
Application.DisplayFormulaBar = False
Set oListBox = _
Me.OLEObjects.Add(ClassType:="Forms.ListBox.1")
With oListBox
Names.Add "ListBoxName", .Name
.Left = Target.Offset(1, 1).Left
.Top = Target.Offset(2, 2).Top
.Width = Me.StandardWidth * 10
.Height = Me.StandardHeight * 10
.ListFillRange = Sheets(2).Name & "!a1:a20"
.Placement = xlFreeFloating
.Object.MultiSelect = fmMultiSelectMulti
With Application
.OnTime Now + _
TimeSerial(0, 0, 0.01), Me.CodeName & ".Hooklistbox"
.CommandBars.FindControl(ID:=1605).Execute
End With
End With
Else
Application.DisplayFormulaBar = True
Names("ListBoxName").Delete
Range(Cell_A1).Interior.ColorIndex = 0
End If
End Sub
Private Sub Hooklistbox()
Application.CommandBars.FindControl(ID:=1605).Reset
Set oTarget = ActiveCell
ActiveCell.Interior.Color = vbYellow
'display the listbox and hook it.
With Me.OLEObjects(Evaluate("ListBoxName"))
.Visible = True
Set Lbx = .Object
End With
End Sub
