Private Sub CreationRDV(strTitre As String, strLieu As String, datJour As Date, bTemp As Boolean, strCat As String) Dim OlApp As Outlook.Application Dim rdv As Outlook.AppointmentItem Dim datDeb As Date, datFin As Date datDeb = datJour + TimeSerial(9, 0, 0) datFin = datJour + TimeSerial(17, 0, 0) Set OlApp = Outlook.Application Set rdv = OlApp.CreateItem(olAppointmentItem) With rdv .Subject = strTitre 'sujet .Location = strLieu 'lieu .Categories = strCat 'catégorie If bTemp Then 'statut .BusyStatus = olTentative Else .BusyStatus = olOutOfOffice End If .Start = datDeb .End = datFin .ReminderSet = False 'rappel .Save 'sauvegarde End With End Sub
A vous maintenant d'utiliser cette fonction pour créer un rendez-vous avec le contenu de cellules de votre classeur. |