Création de rendez-vous Outlook 2016 à partir de Excel2010 [Résolu] - Forum Excel

Création de rendez-vous Outlook 2016 à partir de Excel2010 Création de dossiers sous Outlook XP (Résolu) Quels parametres pour outlook 2016 (Résolu) Problème Thunderbirds par défaut envoi par Outlook 2016 (Résolu) Relève automatique Outlook 2016 (Résolu) Outlook 2016 [Résolu] (Résolu)

Bonjour,

J'utilise un tableau excel pour faire le suivi de plusieurs étapes de la préparation des formations de mon département. Pour en faciliter le suivi j'aimerais pouvoir transférer les dates importantes dans mon calendrier outlook.

En cherchant sur les forums j'ai trouvé un code que je suis parvenue à adapter pour que la bonne information se transfère, mais pour un seul événement. J'aimerais bien que cela puisse se faire pour l'ensemble d'entre eux.

Voici le code que j'ai pour le moment:

#
Sub NouveauRDV_Calendrier()
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem

Set Rdv = OkApp.CreateItem(olAppointmentItem)

With Rdv
.MeetingStatus = olMeeting
.Subject = Range("a2")
.Body = "préparer liste de présence et cahiers des participants"
.Location = Range("e2")
.Start = Range("c2")
.Categories = "préparation outils"
.ReminderMinutesBeforeStart = 2880
.AllDayEvent = True
.ReminderSet = True
.Save
End With

Set OkApp = Nothing
End Sub
#

Merci beaucoup de votre aide
A

Forum

Création de rendez-vous Outlook 2016 à partir de Excel2010 Création de dossiers sous Outlook XP (Résolu) Quels parametres pour outlook 2016 (Résolu) Problème Thunderbirds par défaut envoi par Outlook 2016 (Résolu) Relève automatique Outlook 2016 (Résolu) Outlook 2016 [Résolu] (Résolu)

Web: www.shapebootstrap.net

19 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

J'aimerais bien que cela puisse se faire pour l'ensemble d'entre eux
comme ceci cela devrait te le permettre :
Sub NouveauRDV_Calendrier() 'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library" Dim OkApp As New Outlook.Application Dim Rdv As Outlook.AppointmentItem Dim lig As Long Set Rdv = OkApp.CreateItem(olAppointmentItem)  With Rdv     For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row         .MeetingStatus = olMeeting         .Subject = Range("A" & lig)         .Body = "préparer liste de présence et cahiers des participants"         .Location = Range("E" & lig)         .Start = Range("C" & lig)         .Categories = "préparation outils"         .ReminderMinutesBeforeStart = 2880         .AllDayEvent = True         .ReminderSet = True         .Save     Next lig End With  Set OkApp = Nothing End Sub 

Reply
réponses:
  • auteur

  • Alethas

    Merci beaucoup de l'aide gbinforme et désolée du retard de réponse, je devais être de retour au travail pour le tester.
    Avec ton code maintenant à la place de ne transférer que le premier événement, il ne transfère maintenant que le dernier.
    As-tu une idée pourquoi?

  • Alethas

    Si j'ajoute un .Display à l'intérieur, je le vois afficher l'information de tous les événements les uns après les autres dans la même page pour s'arrêter seulement sur le dernier (je ne sais pas si ça aide à trouver le problème.)

  • gbinforme

    Bonjour,

    Je n'utilise pas cet agenda et je t'ai fait au jugé la modification.
    En fait, je pense que j'ai mal placé la boucle, essaie ainsi :

    Sub NouveauRDV_Calendrier() 'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library" Dim OkApp As New Outlook.Application Dim Rdv As Outlook.AppointmentItem Dim lig As Long     For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row         Set Rdv = OkApp.CreateItem(olAppointmentItem)         With Rdv             .MeetingStatus = olMeeting             .Subject = Range("A" & lig)             .Body = "préparer liste de présence et cahiers des participants"             .Location = Range("E" & lig)             .Start = Range("C" & lig)             .Categories = "préparation outils"             .ReminderMinutesBeforeStart = 2880             .AllDayEvent = True             .ReminderSet = True             .Save             .Close (olSave)         End With         Set Rdv = Nothing     Next lig Set OkApp = Nothing End Sub 

  • Alethas

    Merci beaucoup ça fonctionne parfaitement maintenant.

    un dernier détail. pour le .start, ma colonne C contenait la date alors que ma colonne D contenait l'heure. penses-tu qu'il y aurait une façon simple dans VBA d'ajouter cette information? ou est-ce que ce serait plus simple à ce moment de faire un champ concaténé dans mon tableau excel directement?

  • gbinforme

    Bonsoir,

    une façon simple dans VBA

               .Start = Range("C" & lig) + Range("D" & lig)

  • Alethas

    merci énormémement pour cette solution toute simple qui marche parfaitement.
    Je commencerai sous peu un cours de VBA et pourrai, je l'espère, répondre à mon tour à des questions

  • gbinforme

    Merci du retour et bienvenue dans le club VBA ! ;-)

  • Alethas

    bon.. désolée mais encore une petite possible modification, est-ce qu'il y a une façon dans ce code que mon rappel soit à 2 jours ouvrables avant l'événement à la place de simplement 2 jours?

  • gbinforme

    Bonsoir,

    une petite possible modification
    C'est un peu plus compliqué car il faut tenir compte des jours fériés et donc il te faut les mettre dans une plage au format date que tu devras nommer "fériés".
    Ensuite tu remplaces

            .ReminderMinutesBeforeStart = 2880

    par
        Dim jrs As Byte, njr As Byte         jrs = 0: njr = 0         While njr < 2            njr = njr + Application.NetworkDays(Range("C" & lig)- jrs, Range("C" & lig)- jrs, Range("fériés"))            jrs = jrs + 1         Wend         .ReminderMinutesBeforeStart = (jrs - 1) * 1440

  • Alethas

    Bonjour

    Merci encore de ton assistance et désolée du délai de réponse.

    Lorsque je remplace ma ligne de reminderminutesbeforestart par ton code il me donne un rappel de 1 jour ouvrable calculant les jours fériés, par contre j'aurais une préférence pour 2 jours ouvrables.
    Lorsque j'essaie de le modifier, si je change .reminderMinutesBeforeStart en enlevant le -1, il me met l'ensemble à 2 jours ouvrables sauf ceux ou la veille est actuellement une journée ouvrable et à ce moment il me fait simplement 2 jours( rappel des événement du mardi le dimanche sauf si lundi férié, à ce moment là il indique correctement le jeudi)

    Je ne sais pas trop qu'est-ce que je pourrais faire pour corriger ceci.

    Si tu peux encore m'aider j'apprécierais beaucoup.

  • gbinforme

    Bonsoir,

    Il te suffit de changer ainsi :

    While njr < 3

  • Alethas

    ça semble parfait maintenant, merci.

    Je viens de penser par contre en cas de mise à jour, est-ce qu'il y a une façon de l'adapter pour lorsqu'on ajoute des événements par la suite ou qu'on en modifie qu'il ne fasse que les modification sans créer de doublon?

    désolée pour toutes ces modifications

    edit: ou qu'il efface les doublons?

  • Alethas

    Rebonjour,

    je relance. Est-ce que ce serait possible d'adapter ce code pour qu'il s'applique à tous les changements lorsque ajoute un événement sans avoir à le repasser au complet et donc créer des doublons de chaque événement pré-existant.

    Je donne le code de où on en est rendu.

    Sub NouveauRDV_Calendrier()
    'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
    Dim OkApp As New Outlook.Application
    Dim Rdv As Outlook.AppointmentItem
    Dim lig As Long
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Set Rdv = OkApp.CreateItem(olAppointmentItem)
    With Rdv
    .MeetingStatus = olNonMeeting
    .Subject = Range("A" & lig)
    .Body = "préparer liste de présence et cahiers des participants"
    .BusyStatus = olFree
    .Location = Range("F" & lig) & " " & Range("G" & lig)
    .Start = Range("C" & lig) + Range("D" & lig)
    .End = Range("C" & lig) + Range("E" & lig)
    .Categories = "Date de formation"
    Dim jrs As Byte, njr As Byte
    jrs = 0: njr = 0
    While njr < 3
    njr = njr + Application.NetworkDays(Range("C" & lig) - jrs, Range("C" & lig) - jrs, Range("fériés"))
    jrs = jrs + 1
    Wend
    .ReminderMinutesBeforeStart = (jrs - 1) * 1440
    .ReminderSet = True
    .Save
    .Close (olSave)
    End With
    Set Rdv = Nothing
    Next lig
    Set OkApp = Nothing
    End Sub


    merci à l'avance de toute votre aide

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

sans avoir à le repasser au complet et donc créer des doublons
Pour cela, je te propose de mémoriser le transfert en colonne G.
Si tu l'utilises pour autre chose tu mets une colonne libre.

Option Explicit  Sub NouveauRDV_Calendrier() 'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library" Dim OkApp As New Outlook.Application Dim Rdv As Outlook.AppointmentItem Dim jrs As Byte, njr As Byte Dim lig As Long, nbt As Integer Set Rdv = OkApp.CreateItem(olAppointmentItem)  With Rdv     For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row         If Range("G" & lig).Value = "" Then             .MeetingStatus = olMeeting             .Subject = Range("A" & lig)             .Body = "préparer liste de présence et cahiers des participants"             .Location = Range("E" & lig)             .Start = Range("C" & lig)             .Categories = "préparation outils"             jrs = 0: njr = 0             While njr < 3                njr = njr + Application.NetworkDays(Range("C" & lig) - jrs, Range("C" & lig) - jrs, Range("fériés"))                jrs = jrs + 1             Wend             .ReminderMinutesBeforeStart = (jrs - 1) * 1440             .AllDayEvent = True             .ReminderSet = True             .Save             nbt = nbt + 1             Range("G" & lig).Value = "Enregistré" ' la colonne G mémorise les transferts         End If     Next lig End With If nbt Then MsgBox nbt & " transferts" Set OkApp = Nothing End Sub

Reply
réponses:
  • Alethas

    Désolée du délai immense et merci pour ta réponse.
    Comme nous sommes quelques-uns a utiliser ce classeur, ça ne fonctionnerait pas vraiment, à moins que je crée une colonne et macro séparée pour chacun des utilisateurs ce qui alourdirait probablement énormément le dossier. Est-ce que tu vois une autre façon qu'on pourrait y arriver?

    Merci encore de toute ton assistance

  • gbinforme

    Bonjour,

    Est-ce que tu vois une autre façon qu'on pourrait y arriver?
    Comme tu n'as jamais expliqué précisément ce que tu souhaitais, c'est mission impossible de te fournir une martingale gagnante.
    Il faudrait sans doute utiliser l'identification de l'utilisateur mais ce sera le premier utilisateur qui sera impacté sauf si la ligne est assignée à un destinataire.

  • auteur

    Désolée du manque de précision. Je parlais de pouvoir transférer les modifications ou mise à jour du tableau excel vers le calendrier outlook, mais comme plusieurs utilisateurs, la méthode avec la colonne de validation ne serait pas vraiment fonctionnelle. À moins d'ajouter une colonne et un module pour chaque utilisateur

  • gbinforme

    Bonjour,

    Désolé effectivement mais transférer les modifications vers le calendrier outlook de plusieurs utilisateurs cela ne veux rien dire. Du moins cela suppose qu'il faudrait savoir quel utilisateur doit récupérer quelle ligne sur son calendrier. Sans autre précision, va falloir installer un module d'intelligence artificielle pour savoir celui qui sera concerné.

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed