XL 2010 Problème de Format date combo-box vers cellule

[reinruof77]

Bonjour a tous

j'ai créer un userform et un combobox qui recupere le nom de l'onglet comme date

le problème est que le format est (12-01-2017) et que lorsque je le met au format date en remplacent les - par /

je suis au format anglais soit (01/12/2017)

le problème ce pose sur la feuil Recap en colonne B.

PS: pour oter la protection de la feuille Ctrl+a.

Merci de votre aide

 

[Lone-wolf]

Bonjour reinrouf

C'est quoi qui cause problème au juste, le format de la combo ou le format dans la feuille?

 

[Robert]

Bonjour Reinruof, Loup Solitaire, bonjour le forum.

Essaie comme ça :

plg = Format(UserForm1.ComboBox2.Value, "yyyy/mm/dd")[/COLOR][/FONT][/COLOR]
[COLOR=#000066][FONT=Arial][COLOR=#000000]

Quand on renvoie une date d'une UserForm vers une cellule il faut lui donner le format américain. Ensuite tu pourras affecter à la cellule réceptrice le format de date que tu veux....

 

[Lone-wolf]

Bonjour Robert

 

[reinruof77]

Merci a tous les deux

Je viens d'essayer mais cela ne fonctionne pas la date est au format 05-01-2017 et lorsque je recois le mail la date est le 01 MAI 2017.

PS: quand je fait un double clic dans la cellule la date est au bon format .

 

[Lone-wolf]

RE

Est-ce que par hazard celà de viendrais pas lors de la créeation du calendrier: "YYYYMMDD"
Et les heures c'est "hh:mm" et non comme tu l'a écrit.

 

[reinruof77]

Je ne pense pas en fait je créer des onglets avec ce code

Dim J As Long
Dim Ws As Worksheet
  Application.ScreenUpdating = False
  Set Ws = Feuil3
  For J = 3 To Ws.Range("A" & Rows.Count).End(xlUp).Row
    If Not Estlà(Format(Ws.Range("A" & J), "dd-mm-yyyy")) Then
      Sheets("Base").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(Ws.Range("A" & J), "dd-mm-yyyy")
      ActiveSheet.Range("A2") = Format(Ws.Range("A" & J), "dddd dd mmmm yyyy")
    End If
  Next J
  Ws.Select

Ensuite dans mon userform je récupére le nom de l'onglet qui va aussi sélectionner la feuille.

et quand je valide les donnés sont envoyer vers la feuille (nom de l'onglet) et sur la feuil ("Recap") et c'est sur cette dernière ou la date est inscrite au format JJ-MM-AAAA .

mais lorsque je reçois le mail comme lequel les informations on été saisie la date est MM/JJ/AAAA.

Merci encore de votre aide.

 

[Lone-wolf]

Re

Celà viens de la messagerie. Je me suis envoiyé un mail sur hotmail et j'ai ceci 02.01.1901 1:00 - 1:00

 

[reinruof77]

a priori cela ne vient pas de la messagerie
puisque lorsque je reçois ICS j'ai cela

et quand je double clic sur la date dans la feuille Recap , la date ce mets au bon Format et je reçois ça

ce que je souhaite.

Est ce qu'il existe un moyen via VBA de faire un double Clic dans la cellule une fois saisie?? cela résoudrais le problème

Merci Encore de ton aide

 

[Lone-wolf]

Dans ce cas

Il faut ajouter dans le code la création de la réunion ou rendez-vous et appliquer le format au combos.

Edit: en cliquand sur la date dans le calendrier, les dates s'affichent correctement. Il faut peut-être modifier le format de date du sytème.

 

[reinruof77]

Heu oui d'accord
et comment je fait cela je ne suis pas trés douer en VBA je me débrouille comme je peux mais compiler deux code différent c'est chaud.

 

[Lone-wolf]

Re

Voici le code, à adapter.

Private Sub Envoyer_Click()
Dim cel As Range, rng As Range, i As Integer, lig As Integer, Temp
Dim Chaine As String, k As Byte

    Dim OlApp As Object, objAppt As Object
    Dim namespaceOutlook As Outlook.Namespace
    Dim DossierCalendrier As Outlook.MAPIFolder

    Application.WindowState = xlMinimized
    Me.TNom = UsfData.TextBox1
    Me.Hide


    With Sheets("Data").Range("a2:o10000")
        Set cel = .Find(TNom.Value, , xlValues)
        If Not cel Is Nothing Then
            TextBox1.Value = cel.Offset(0, 0) & Chr(60) & cel.Offset(0, 3) & Chr(62)
            RnName = TextBox1.Value
            RnDeb = cel.Offset(0, 14)
            RnFin = cel.Offset(0, 11)
            cel.Offset(0, 12).Value = ComboBox4.Value
        End If
    End With

    RnSubject = TextBox2
    RnBody = TextBox3
    RnLocation = ComboBox1
    RnCategories = Lbl_Cat.Caption
    Chemin = "C:\Windows\Media\Windows Notify Calendar.wav"


    With Sheets("Categories").Range("f3:g26")
        Set rng = .Find(ComboBox4.Value, , xlValues)
        If Not rng Is Nothing Then
            Temp = rng.Offset(0, 1) / 60
            RnRappel = Temp * 60
        End If


        With UsfData

            For k = 0 To .ListBox1.ListCount - 1
                If .CheckBox1 = True Then
                    Chaine = Chaine & " " & cel.Offset(k, 0) & Chr(60) & .ListBox1.List(k) & Chr(62) & ";"
                    RnName = Chaine
                End If
            Next k
        End With
        On Error Resume Next

        Set OlApp = CreateObject("Outlook.Application")

        With OlApp
            .ActiveWindow.WindowState = olMinimized   ' olMinimized = 1 - Normale = 2
            Set objAppt = OlApp.CreateItem(1)
            Set namespaceOutlook = OlApp.GetNamespace("MAPI")
            Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
            Set objAppt = DossierCalendrier.Items.Add
        End With

        With objAppt
            .MeetingStatus = olMeeting
            .Subject = RnSubject
            .Body = RnBody
            .Location = RnLocation
            .Start = RnDeb
            .Duration = RnFin
            .Categories = RnCategories
            .ReminderMinutesBeforeStart = RnRappel
            .ReminderSet = True
            .ReminderPlaySound = True
            .ReminderSoundFile = Chemin
            .RequiredAttendees = RnName
            .Display
            '.Save
            '.Send
        End With


        Application.DisplayAlerts = False
        Set OlApp = Nothing
        Set objAppt = Nothing
    End With
End Sub

 

[reinruof77]

re bonjour au risque de paraître idiot je n'y comprend rien

 

[Lone-wolf]

Re

Ajoute ceci à ton code ou crée une nouvelle macro; et à la place des commentaires met les cellules correspondantes. Ensuite tu met Call Calendrier par exemple.

Sub TEST()
Dim OlApp As Object, objAppt As Object
Dim namespaceOutlook As Outlook.Namespace
Dim DossierCalendrier As Outlook.MAPIFolder
Dim dateDeb, d

  Set OlApp = CreateObject("Outlook.Application")

  With OlApp
  Set objAppt = OlApp.CreateItem(1)
  Set namespaceOutlook = OlApp.GetNamespace("MAPI")
  Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
  Set objAppt = DossierCalendrier.Items.Add
  End With

  'ici c'est le 6 mars
  d = DateSerial(Year(Date), Month(Date), Day(Date) + 16) & " " & "7:30:00AM"

  dateDeb = Format(d, "dd/mm/yyyy hh:mm")
  With objAppt
  .MeetingStatus = olMeeting
  .Subject = "TITRE DU SUJET"
  .Body = "CORPS DU MESSAGE"
  .Location = "LIEU"
  .Start = dateDeb  'DATE ET HEURE DE DEBUT
  .Duration = 570  'DURÉE DE LA JOURNÉE EN MINUTES       'ici fin de la journée à 17:00h
  .Display
  End With
End Sub