'///ajout (à retirer)
''''Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
''''
''''End Sub
Option Explicit
Dim interne As Boolean
Private Sub LbxVille_Change()
Dim ch As String, i As Long, sep As String
If Not interne Then
ch = ""
sep = [Séparateur]
For i = 0 To LbxVille.ListCount - 1
If LbxVille.Selected(i) = True Then ch = ch & sep & LbxVille.List(i)
Next i
ch = Mid(ch, Len(sep) + 1)
ActiveCell = ch
End If
End Sub
Private Sub LbxVille_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ch As String, ch2 As String, pos As Long, i As Long
Dim plage, nomListe, numListe As Long, topIndex As Boolean
' plages avec sélection multiple sur cette feuille
plage = Array("C50")
' nom des Feuil3 dans la feuille Feuil3 (en liaison avec les plages définies au-dessus)
nomListe = Array("Ville")
' plage concernée ?
For numListe = 0 To UBound(plage)
If Not Intersect(Target, Range(plage(numListe))) Is Nothing Then Exit For
Next numListe
If numListe <= UBound(plage) Then ' si plage de liste existant
' initialiser listbox
LbxVille.ListFillRange = "Feuil3!" & Worksheets("Feuil3").Range(nomListe(numListe)).Address ' A2:A17" ' [Feuil3!Ville].Address
LbxVille.Top = Target.Offset(1, 0).Top
LbxVille.Left = Target.Offset(0, 1).Left
interne = True ' palliatif, EnableEvents ne marche pas
ch = ActiveCell
ch2 = [Séparateur] & ch & [Séparateur]
topIndex = False
' sélectionner selon contenu cellule
For i = 0 To LbxVille.ListCount - 1
If InStr(ch2, [Séparateur] & LbxVille.List(i) & [Séparateur]) > 0 Then
' l'item a été trouvé dans la cellule
LbxVille.Selected(i) = True
If Not topIndex Then
LbxVille.topIndex = i ' le 1er sélectionné doit être visible dans la textbox
topIndex = True
End If
End If
Next i
interne = False
' afficher textbox
LbxVille.Visible = True
Else
' ne plus afficher la textbox
LbxVille.Visible = False
End If
End Sub
Sub reinit()
Application.EnableEvents = True
End Sub
'Afichage du calendrier lors d'un double clic
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim plage As Range '///ajout
'liste des cellules à modifier sur lesquelles apparait le calendrier
Set plage = Range("C13, G13, G15, D31, F31, B35, B37, B39, C46, C48, C57, C69")
If Not Intersect(Target, plage) Is Nothing Then
Cancel = True
UserForm1.Show
End If
End Sub
