Création rendez vous outlook en VBA

Bonjour à tous

j'ai adapté une macro trouvée sur le forum pour la création d'un rendez vous outlook basé sur mon fichier excel.

je n'ai qu'une seule ligne à chaque fois donc je l'ai adapté à mes besoins.

le rendez vous se crée bien mais impossible de modifier la date de démarrage, il démarre bien sur le bon jour mais, je n'arrive pas à modifier la formule pour qu'il me l'active sur la bonne heure

pourriez vous m'aider ?

Sub GCR_RDV()
' Créer un RDV d'Outlook
Sheets("Calendrier").Activate
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Calendrier")
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For lig = 1 To DLig
        ' Importation du RDV
        DateRdv = CDate(Range("B" & lig))
        Set OutAppt = OutObj.CreateItem(olAppointmentItem)
        With OutAppt
          .Subject = Sheets("Calendrier").Range("C" & lig).Text
          .Start = Sheets("Calendrier").Range("B") + Range("D").Value
          .End = Sheets("Calendrier").Range("B" & lig).Value
          .Duration = Sheets("Calendrier").Range("F" & lig).Value
          .Body = Sheets("Calendrier").Range("G" & lig).Text
          .ReminderSet = True
          .Save
             End With
  Next lig
  End With
  Set OutAppt = Nothing
Sheets("DATA_Mail").Activate
  End Sub

Bonjour Cfrancky77

Sans un fichier exemple des données, cela est compliqué, mais le problème ce situe ici

.Start = Sheets("Calendrier").Range("B") + Range("D").Value

Il manque la ligne et le nom de la feuille pour la colonne D

Pensez à définir vos variables, vous aurez moins de problèmes par la suite

Un exemple de ce que le code correcte pourrait être

Option Explicit
Sub GCR_RDV()
  Dim Lig As Long, dLig As Long
  Dim DateRdv
  Dim Sht As Worksheet
  Dim OutObj As Object
  ' Définir la feuille
  Set Sht = Sheets("Calendrier")
  ' Créer un RDV d'Outlook
  Set OutObj = CreateObject("outlook.application")
  ' Avec la feuille
  With Sheets("Calendrier")
    dLig = Sht.Range("B" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 1 To dLig
      ' Importation du RDV
      Set OutAppt = OutObj.CreateItem(olAppointmentItem)
      With OutAppt
        .Subject = Sht.Range("C" & Lig).Text
        DateRdv = Sht.Range("B" & Lig) + Sht.Range("D" & Lig).Value
        .Start = DateRdv
        '.End = Sht.Range("B" & Lig).Value (Non valide)
        .Duration = Sht.Range("F" & Lig).Value
        .Body = Sht.Range("G" & Lig).Text
        .ReminderSet = True
        .Save
      End With
    Next Lig
  End With
  Set OutAppt = Nothing: Set Sht = Nothing
  Sheets("DATA_Mail").Activate
End Sub

A+

Bonsoir et merci beaucoup pour le retour

je ne comprends pas pourquoi la ligne .end plante donc je l'ai commenté mais pour le reste c'est impeccable

Merci beaucoup pour l'aide

Bonsoir Cfrancky77 et de rien

Je n'ai jamais vu l'utilisation de "End", j'ai oublié de le mettre en commentaire

Comme vous avez la date de début et la durée, pourquoi vouloir mettre une fin

L'essentiel est que ça fonctionne comme vous le souhaitez