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

A voir également:Création de rendez-vous outlook 2016 à partir de excel2010Création formulaire outlook 2016 - Articles Afficher tous les rendez vous dans outlook 2016 - Articles Outlook 2016 gratuit - Conseils pratiques - Equivalents gratuits Message absence outlook 2016 - Conseils pratiques - Microsoft Outlook Création d'un compte outlook - Conseils pratiques - Outlook.com

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

A voir également:Création de rendez-vous outlook 2016 à partir de excel2010Création formulaire outlook 2016 - Articles Afficher tous les rendez vous dans outlook 2016 - Articles Outlook 2016 gratuit - Conseils pratiques - Equivalents gratuits Message absence outlook 2016 - Conseils pratiques - Microsoft Outlook Création d'un compte outlook - Conseils pratiques - Outlook.com

Web: www.shapebootstrap.net

2 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 

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 58418 internautes nous ont dit merci ce mois-ci

Reply
réponses:
  • auteur

  • auteur

    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?

  • auteur

    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.)

  • auteur

    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 

  • auteur

    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?

  • auteur

    Bonsoir,

    une façon simple dans VBA

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

  • auteur

    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

  • auteur

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

  • auteur

    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?

  • auteur

    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

  • auteur

    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.

  • auteur

    Bonsoir,

    Il te suffit de changer ainsi :

    While njr < 3

  • auteur

    ç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?

  • auteur

    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:
  • auteur

    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

  • auteur

    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

  • auteur

    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