Macro en remplacement d'une liste de choix

[boudebois]

Bonjour,
Pour le suivi d'un budget, j'ai préparé un tableau avec Excel 2003
J'aimerai créer un bouton avec une macro pour remplacer la liste de choix avec index que j'ai actuellement.
Ci joint des captures d'écran de mon fichier
Je dois remplir automatiquement la colonne C selon le choix de la ligne B.😱

Merci

 

[tototiti2008]

Re : Macro en remplacement d'une liste de choix

Bonjour boudebois,

Bienvenue sur XLD,

un petit fichier exemple serait plus parlant qu'une image

 

[boudebois]

Re : Macro en remplacement d'une liste de choix

En effet ce sera surement plus explicite
Merci de l'attention donner a mon message.
@+😉

 

[job75]

Re : Macro en remplacement d'une liste de choix

Bonjour boudebois, tototiti,

Voyez le fichier joint.

Dans ThisWorkbook :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Name = "Budget 09" Or Target.Interior.ColorIndex > 0 _
  Or Intersect(Target, Sh.Columns(2)) Is Nothing Then Exit Sub
Cancel = True
UserForm1.Show
End Sub

Dans le code de l'UserForm :

Private Sub ComboBox1_Change()
Dim lig As Variant
ActiveCell = ComboBox1
lig = Application.Match(ComboBox1, [Categories], 0)
If IsNumeric(lig) Then
ActiveCell.Offset(, 1) = [Categories].Offset(, 1)(lig)
Else
ActiveCell.Offset(, 1) = ""
End If
End Sub

Private Sub UserForm_Initialize()
ComboBox1.SetFocus
SendKeys "%{DOWN}"
End Sub

A+

 

[boudebois]

Re : Macro en remplacement d'une liste de choix

Super, cela me convient parfaitement, maintenant je vais essayer de comprendre la logique.
merci beaucoup🙂

 

[job75]

Re : Macro en remplacement d'une liste de choix

Re,

On peut aussi utiliser des listes de validation, c'est plus classique mais pas toujours très lisible...

Dans ThisWorkbook :

Private Sub WorkBook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Sh.Name = "Budget 09" Or Intersect(Source, Sh.Columns(2)) Is Nothing Or Source.Count > 1 Then Exit Sub
If Source.Interior.ColorIndex > 0 Then Exit Sub
Dim lig As Variant
lig = Application.Match(Source, [Categories], 0)
If IsNumeric(lig) Then
Source.Offset(, 1) = [Categories].Offset(, 1)(lig)
Else
Source.Offset(, 1) = ""
End If
End Sub

A+