Création de rendez-vous Outlook 2016 à partir de Excel2010

Résolu
Alethas -  
gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   -
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

2 réponses

  1.
    gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    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

    2
    1. Alethas Messages postés 14 Statut Membre
       
      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?
      0
    2. Alethas Messages postés 14 Statut Membre
       
      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.)
      0
    3. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
       
      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
      0
    4. Alethas Messages postés 14 Statut Membre
       
      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?
      0
    5. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
       
      Bonsoir,

      une façon simple dans VBA 
                 .Start = Range("C" & lig) + Range("D" & lig)
      0
  2. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    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

    0
    1. Alethas Messages postés 14 Statut Membre
       
      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
      0
    2. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
       
      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.
      0
    3. Alethas
       
      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
      0
    4. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
       
      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é.
      0

Discussions similaires

Chemin Logo du site de la Cité de l'espace
Keiios -
blux -

11 réponses