XL 2019 Combobox à partir d'un fichier fermé

gui64600

XLDnaute Nouveau
Bonjour,
Jai un fichier source.xlsm qui en colonne A de la feuille "source" contient des noms.
Je voudrais dans un autre fichier résultat.xlsm créer une combobox me permettant une saisie semi-automatique des noms du fichier source en cellule C2

Le fichier A est fermé.

Merci de votre aide
 

patricktoulon

XLDnaute Barbatruc
un autre pour une date
VB:
Sub test2()
    Dim a, forme
    a = "20 mars 2020"
    If IsDate(a) Then
         Select Case True
        Case Format(a, "dd mmmm yyyy") = a: forme = "dd mmmm yyyy"
        Case Format(a, "dd mmm yyyy") = a: forme = "dd mmm yyyy"
        'etc....
        End Select
    a = DateValue(a)
       End If
    With [A22]
        .Value = CDate(a)
        .NumberFormat = forme
    End With

End Sub
 

patricktoulon

XLDnaute Barbatruc
tien on elargi un peu les formats
VB:
Sub test2()
    Dim a, forme
    a = "20-mars-2020 20:52:32"
    'a = "20 mars 2020 20:52:32"
    'a = "20/03/2020 20:52:32"
    If IsDate(a) Then
        Select Case True
        Case Format(a, "dd mmmm yyyy") = a: forme = "dd mmmm yyyy"
        Case Format(a, "dd mmm yyyy") = a: forme = "dd mmm yyyy"
        Case Format(a, "dd mmm yyyy hh:nn:ss") = a: forme = "dd mmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn:ss") = a: forme = "dd-mmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd mm yyyy hh:nn:ss") = a: forme = "dd mm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn:ss") = a: forme = "dd/mm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
            'etc....
        End Select
    End If
    With [A22]
        .Value = a
        .NumberFormat = forme
    End With
End Sub
 

Dudu2

XLDnaute Barbatruc
Dans mon code il y a des fonctions qui font ça:
- IsDateTexte()
- IsNumericTexte()
- IsNumericMonétaireTexte
- IsNumericPourcentageTexte()
- IsFractionTexte()

Pour les dates c'est un peu plus compliqué car les formats de dates sont très nombreux.
La fonction couvre une grande majorité d'entre eux.

Les paramètres Valeur & NumberFormat sont en sortie si la fonction retourne True.
VB:
Private Const JoursSemaine = "dimanche,lundi,mardi,mercredi,jeudi,vendredi,samedi"
Private Const MoisAnnée = "janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre"

'-------------------------
'Valeur texte est une date
'-------------------------
Private Function IsDateTexte(ByVal Val As String, Valeur As Variant, NumberFormat As String) As Boolean
    Dim TabDate() As String
    Dim TabHeure() As String
    Dim i As Integer
    Dim j As Integer
    Dim Sep As String
    Dim JourSemaineTrouvé As Boolean
    Dim SepJourSemaine As String
    Dim FormatJourSemaine As String
    Dim LenJourSemaine As Integer
    Dim HeureTrouvée As Boolean
    Dim FormatHeure As String
    Dim S As String
    Static TabJours() As String
  
    'Initialisations
    Valeur = ""
    NumberFormat = ""
  
    'Initialisation TabJours()
    If Not (Not TabJours) Then Else TabJours = Split(JoursSemaine, ",")

    'Nombre en texte n'est pas une date
    If IsNumeric(Val) Then Exit Function
  
    'Excel ne reconnait pas comme une date un texte "dimanche 6 décembre 2020", il faut l'aider
    '-----------------------------------
    'Format date avec jour de la semaine
    '-----------------------------------
    For i = LBound(TabJours) To UBound(TabJours)
        If Left(Val, Len(TabJours(i))) = TabJours(i) Then Exit For
    Next i
    If i <= UBound(TabJours) Then
        JourSemaineTrouvé = True
        FormatJourSemaine = "dddd"
        LenJourSemaine = Len(TabJours(i))
    Else
        For i = LBound(TabJours) To UBound(TabJours)
            If Left(Val, 3) & "." = Left(TabJours(i), 3) & "." Then Exit For
        Next i
        If i <= UBound(TabJours) Then
            JourSemaineTrouvé = True
            FormatJourSemaine = "ddd"
            LenJourSemaine = 4
        End If
    End If

    If JourSemaineTrouvé Then
        'Retire le jour et le séparateur de la valeur texte
        If Len(Val) > LenJourSemaine + 1 Then
            S = Mid(Val, LenJourSemaine + 2)
          
            If IsDate(S) Then
                If Weekday(CDate(S)) = i + 1 Then
                    SepJourSemaine = Mid(Val, LenJourSemaine + 1, 1)
                    Val = S
                End If
            End If
        End If
    End If

    '---------------------
    'Ce n'est pas une date
    '---------------------
    If Not IsDate(Val) Then Exit Function
  
    '-------------------------
    'Conversion en date locale
    '-------------------------
    Valeur = CDate(Val)
  
    '----------------------
    'Format date avec heure
    '----------------------
    TabDate = Split(Val, " ")
  
    TabHeure = Split(TabDate(UBound(TabDate)), ":")
    HeureTrouvée = False
  
    If UBound(TabHeure) = 1 Then
        If IsNumeric(TabHeure(0)) And IsNumeric(TabHeure(1)) Then
                FormatHeure = "h:mm"
                HeureTrouvée = True
        End If
    End If
    If UBound(TabHeure) = 2 Then
        If IsNumeric(TabHeure(0)) And IsNumeric(TabHeure(1)) And IsNumeric(TabHeure(2)) Then
                FormatHeure = "h:mm:ss"
                HeureTrouvée = True
        End If
    End If
  
    If HeureTrouvée Then
        'Retire l'heure de la valeur texte
        Val = ""
        For j = LBound(TabDate) To UBound(TabDate) - 1
            If Len(Val) > 0 Then Val = Val & " "
            Val = Val & TabDate(j)
        Next j
    End If

    '--------------------------------------------
    'Tentatives pour quelques formats de dates
    'en excluant le jour de la semaine et l'heure
    'qui sont traités séparément ci-dessus
    '--------------------------------------------
    Do While 1
        For i = 1 To 3
            Select Case i
                Case 1
                    Sep = "/"
                Case 2
                    Sep = " "
                Case 3
                    Sep = "-"
            End Select
          
            TabDate = Split(Val, Sep)
          
            'mmm/yy ou mmm/yyyy ou mmm yy ou mmmm yyyy ou mmm-yy ou mmmm-yyyy
            If UBound(TabDate) = 1 Then
                If Not IsNumeric(TabDate(0)) And IsNumeric(TabDate(1)) Then
                    NumberFormat = FormatMois(TabDate(0)) & Sep & _
                                   String(Len(CStr(TabDate(1))), "y")
                    Exit Do
                End If
            End If
          
            'dd/mm/yy ou dd/mm/yyyy ou dd mm yy ou dd mm yyyy ou dd-mm-yy ou dd-mm-yyyy
            If UBound(TabDate) = 2 Then
                If IsNumeric(TabDate(0)) And IsNumeric(TabDate(1)) And IsNumeric(TabDate(2)) Then
                    NumberFormat = String(Len(TabDate(0)), "d") & Sep & _
                                   "mm" & Sep & _
                                   String(Len(CStr(TabDate(2))), "y")
                    Exit Do
                End If
            End If
          
            'dd/mmm/yy ou dd/mmm/yyyy ou dd mmm yy ou dd mmmm yyyy ou dd-mmm-yy ou dd-mmmm-yyyy
            If UBound(TabDate) = 2 Then
                If IsNumeric(TabDate(0)) And Not IsNumeric(TabDate(1)) And IsNumeric(TabDate(2)) Then
                    NumberFormat = String(Len(TabDate(0)), "d") & Sep & _
                                   FormatMois(TabDate(1)) & Sep & _
                                   String(Len(CStr(TabDate(2))), "y")
                    Exit Do
                End If
            End If
        Next i
      
        Exit Do
    Loop
  
    'Ajoute le jour de la semaine si détecté
    If JourSemaineTrouvé Then NumberFormat = FormatJourSemaine & SepJourSemaine & NumberFormat
  
    'Ajoute l'heure si détéctée
    If HeureTrouvée Then NumberFormat = NumberFormat & IIf(Len(NumberFormat) > 0, " ", "") & FormatHeure
  
    'Format par défaut
    If Len(NumberFormat) = 0 Then NumberFormat = "m/d/yyyy"
  
    IsDateTexte = True
End Function

Private Function FormatMois(Mois As String) As String
    Dim i As Integer
    Static TabMois() As String
    
    'Initialisation TabMois()
    If Not (Not TabMois) Then Else TabMois = Split(MoisAnnée, ",")
    
    For i = LBound(TabMois) To UBound(TabMois)
        If Mois = TabMois(i) Then Exit For
    Next i
    
    If i <= UBound(TabMois) Then FormatMois = "mmmm" Else FormatMois = "mmm"
End Function
 

Dudu2

XLDnaute Barbatruc
Pour les ListBox et les ComboBox, il n'y a pas besoin de faire tout ce binz.
Leurs valeurs sont par définition en texte et donc le retour texte du SQL est parfaitement adapté.
C'est pour ça que j'ai fait 2 fonctions:
- L'une qui retourne la table "nature" (texte) utilisable pour charger les ListBox & ComboBox
- L'autre qui charge un Range où il faut retrouver les formats (ce qui n'est pas du tout mission impossible, surtout si on ne cherche pas à couvrir les formats extravagants)
Ça va le sauver de la rupture 😇
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
tiens que pense tu de celle ci si on la transforme en fonction
VB:
Sub test2()
    Dim a, forme
    'a = "20-mars-2020 20:52:32"
    'a = "vendredi 20-mars-2020 20:52:32"
    a = "ven. 20-mars-2020 20:52:32"
    'a = "20 mars 2020 20:52:32"
    'a = "20/03/2020 20:52:32"
    'a = "20/03/2020"
    
    If Not IsDate(a) Then
        If Not IsNumeric(Left(a, 3)) Then ddd = "ddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Not Left(a, 5) Like "*.*" Then ddd = "ddddd ": b = Mid(a, InStr(1, a, " ") + 1)
        If Not IsNumeric(Left(a, 5)) And Left(a, 5) Like "*.*" Then ddd = "ddd. ": b = Mid(a, InStr(1, a, " ") + 1)
        If b <> "" Then a = b
    End If
    If IsDate(a) Then
        Select Case True
        Case Format(a, "dd mmmm yyyy") = a: a = CDate(a): forme = "dd mmmm yyyy"
        Case Format(a, "dd mmm yyyy") = a: a = CDate(a): forme = "dd mmm yyyy"
        Case Format(a, "dd mmm yyyy hh:nn:ss") = a: forme = "dd mmm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd-mmm-yyyy hh:nn:ss") = a: forme = "dd-mmm-yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd mm yyyy hh:nn:ss") = a: forme = "dd mm yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd/mm/yyyy hh:nn:ss") = a: forme = "dd/mm/yyyy hh:mm:ss": a = DateValue(a) + TimeValue(a)
        Case Format(a, "dd/mm/yyyy") = a: forme = "dd/mm/yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd-mm-yyyy") = a: forme = "dd-mm-yyyy": a = DateValue(a): ddd = ""
        Case Format(a, "dd/mm/yy") = a: forme = "dd/mm/yy": a = DateValue(a): ddd = ""
            'etc....
        End Select
    End If
    With [A22]
        .Value = a
        .NumberFormat = ddd & forme
    End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
bonjour @Dudu2
oui je cherche justement a réduire de façon a ce que ça devienne pas une usine a gaz et augmenter le nombre de format possible en restant dans une norme bien sur
le problème étant la reconnaissance de date quand le dd est exprimé en texte les 3 if veillent mais j'ai
déjà vu d'autres format moins conventionels :rolleyes:
por les format "€,%,etc) c'est pas un problème je reprend la syntaxe du format proposé par excel
peut tu faire une liste de format de date conventionel (ou pas) que tu a déjà vu
je vais créer un post dédié a la création de cette fonction tu es intéressé ?
 

Discussions similaires

Réponses
15
Affichages
248

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 852
dernier inscrit
dthi16088