problème liste déroulante

[stid59]

Bonjour,

J'effectue un satge sous Excel et j'ai un petit soucis : j'aimerai que lorsque l'utilisateur double clic dans une cellule, un formulaire s'ouvre. Ensuite, il sélectionne une valeur dans une liste déroulante puis clic sur un bouton OK. Une fenetre s'ouvre lui demandant de confirmer son choix. S'il confirme, j'aimerai que la valeur sélectionnée dans la liste soit copiée/collée dans la cellule où l'utilisateur a double cliqué.

Voici le code VB que j'ai créé :


Option Explicit
Public cible As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

cible = Target.Address
UserForm1.Show
cancel = True

End Sub
Private Sub BoutonOK_Click()

If MsgBox("Voulez-vous appliquer le motif " & ListBox1.Value & "?", vbYesNo) = vbYes Then
ActiveSheet.Range(cible).Value = ListBox1.Value
End If
SendKeys "{ENTER}"
SendKeys "{UP}"
Unload UserForm1

End Sub

Private Sub UserForm_Initialize()

'remplissage de la zone de liste
With ListBox1
.AddItem "ALM"
.AddItem "ASA"
.AddItem "ASAI"
.AddItem "ATA"
.AddItem "ATM"
.AddItem "CA"
.AddItem "CFS"
.AddItem "CGM"
.AddItem "FORM"
.AddItem "GREV"
.AddItem "JAS"
.AddItem "MAT"
.AddItem "QS"
End With

'sélectionner le premier élément de la liste
ListBox1.ListIndex = 0

End Sub


Le problème est que lorsque je sélectionne une valeur, clic sur ok puis sur oui, aucune valeur ne se met dans la cellule où j'ai double cliqué. Comment faire pour que la valeur apparaisse ?

Merci d'avance.

 

[JORDAN]

Re : problème liste déroulante

Bonjour Stid59,

Peut etre en rajoutant ActiveCell = ListBox1.value

Bonne journée

 

[stid59]

Re : problème liste déroulante

non ça ne fonctionne pas :s

Voici le code complet :

Option Explicit
Public cible As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

cible = Target.Address
UserForm1.Show
cancel = True

End Sub
Private Sub BoutonOK_Click()

If MsgBox("Voulez-vous appliquer le motif " & ListBox1.Value & "?", vbYesNo) = vbYes Then
ActiveSheet.Range(cible).Value = ListBox1.Value
End If
SendKeys "{ENTER}"
SendKeys "{UP}"
Unload UserForm1

End Sub

Private Sub UserForm_Initialize()

'remplissage de la zone de liste
With ListBox1
.AddItem "ALM"
.AddItem "ASA"
.AddItem "ASAI"
.AddItem "ATA"
.AddItem "ATM"
.AddItem "CA"
.AddItem "CFS"
.AddItem "CGM"
.AddItem "FORM"
.AddItem "GREV"
.AddItem "JAS"
.AddItem "MAT"
.AddItem "QS"
End With

'sélectionner le premier élément de la liste
ListBox1.ListIndex = 0

End Sub




En l'exécutant aucune valeur n'apparait dans la cellule ou j'ai double cliqué et je n'arrive pas à savoir pourquoi

 

[Hulk]

Re : problème liste déroulante

Hello,

Perso j'ai fais comme ceci en supposant que "cible" c'est A1.

Dans la feuille

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

If Not Application.Intersect(Target, [A1]) Is Nothing Then
UserForm1.Show
cancel = True
End If

End Sub

et dans l'USF petit bout modifié

If MsgBox("Voulez-vous appliquer le motif " & ListBox1.Value & "?", vbYesNo) = vbYes Then
ActiveSheet.Range("A1").Value = ListBox1.Value
End If

Peut-être que...

Cdt, Hulk.

 

[Hulk]

Re : problème liste déroulante

Re,

Au fait j'ai trouvé pourquoi.. il fallait mettre cible entre guillemets !

Private Sub BoutonOK_Click()

If MsgBox("Voulez-vous appliquer le motif " & ListBox1.Value & "?", vbYesNo) = vbYes Then
ActiveSheet.Range("cible").Value = ListBox1.Value
End If
SendKeys "{ENTER}"
SendKeys "{UP}"
Unload UserForm1

End Sub

et

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

If Not Application.Intersect(Target, Range("cible")) Is Nothing Then
UserForm1.Show
cancel = True
End If

End Sub

Cdt, Hulk.

 

[Hulk]

Re : problème liste déroulante

Re,

Au fait je viens de me rendre compte de ce que tu veux réellement que maintenant

Jordan avait raison !

Comme ceci ça joue donc

Public cible As String
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

cible = Target.Address
UserForm1.Show
cancel = True

End Sub

et

If MsgBox("Voulez-vous appliquer le motif " & ListBox1.Value & "?", vbYesNo) = vbYes Then
ActiveCell = ListBox1.Value
End If

Je crois que cette fois c'est bon

Cdt, Hulk.