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

reinruof77

XLDnaute Occasionnel
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
 

Pièces jointes

  • Réservation Formation GF-SF-EPI 2017+ mail.xlsm
    562.7 KB · Affichages: 63

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Reinruof, Loup Solitaire, bonjour le forum.

Essaie comme ça :
VB:
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....
 

reinruof77

XLDnaute Occasionnel
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.
date.PNG


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

reinruof77

XLDnaute Occasionnel
Je ne pense pas en fait je créer des onglets avec ce code
VB:
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.
 

reinruof77

XLDnaute Occasionnel
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
recp2.PNG


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

XLDnaute Barbatruc
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.
 

Lone-wolf

XLDnaute Barbatruc
Re

Voici le code, à adapter.

VB:
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
 

Lone-wolf

XLDnaute Barbatruc
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.

VB:
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
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
228
Réponses
2
Affichages
299

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345