Discussion :

[Guy7700]

Bonjour à toutes et tous,

Je sais que plusieurs sujets existent mais je me permets d'en ouvrir un nouveau car le problème que je rencontre n'est pas repris et j'espère que ce fil pourra aider d'autres utilisateurs.

Je me lance donc !

Un collègue gère différentes personnes. Il a, pour ce faire, créer un fichier excel par collaborateur. Il m'a demandé s'il était possible, pour gagner du temps, d'exporter les données excel vers outlook.

Après maintes recherches (je ne suis pas un as en VBA), j'ai finalement trouvé un code (que j'ai un peu adapté) qui fonctionne. J'y ai même intégré une couleur par collaborateur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
'Reference importante : Microsoft Outlook xx Object library (Menu Outils/Références)
Sub ajout()
 
Dim DateDebut As String
Dim Nom As String
Dim journee As String
Dim sSearch As String
Dim OutlApp As New Outlook.Application
Dim OutlItems As Outlook.Items
Dim OutlAppointment As Outlook.AppointmentItem
Dim MyCalendar As Outlook.Items
Dim OutlMapi As Outlook.Namespace
Dim OutlFolder As Outlook.MAPIFolder
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
Dim cal As String
 
Module_màj.TextBox2.Visible = False
Module_màj.TextBox1.Visible = False 'indique la mise à jour de RDV dans le calendrier
 
'plage de données
cal = Sheets("Menu").Range("A1")
For Each Cell In Sheets(cal).Range("A2:A1000")
'fin de plage de données
 
'Pour la vérification des doublons on utilise les données suivantes :
If Cell <> "" Then 'recherche dans la plage s'il existe des données à inscrire
DateDebut = Cell.Offset(0, 6) & " " & Cell.Offset(0, 7) 'date
Nom = Cell.Offset(0, 2) & " " & Cell.Offset(0, 3) & " " & Cell.Offset(0, 4) 'nom
'journee = Cell.Offset(0, 6) 'Toute la journée oui/non
'Fin des données pour la validation de doublon
 
'Crée la sélection du calendrier dans Outlook
Set OutlApp = CreateObject("Outlook.Application")
Set OutlMapi = OutlApp.GetNamespace("MAPI")
Set OutlFolder = OutlMapi.GetDefaultFolder(olFolderCalendar)
Set OutlItems = OutlFolder.Folders("Test calpartagé Miguel").Items 'Nom du calendrier - Attention calendrier ajouté en dessous du calendrier par défaut et nom dans un nouveau groupe.
'Set OutlItems = OutlFolder.Items 'Calendrier par défaut
 
'Vérification de doublons pour les rdv
On Error Resume Next
sSearch = "[AllDayEvent] = '" & journee & "' and [Start] = '" & DateDebut & "' and  [Subject] = '" & Nom & "'"
Set OutlAppointment = OutlItems.Find(sSearch)
On Error GoTo 0
'fin vérification doublons
 
 
If OutlAppointment Is Nothing Then 's'il n'y a pas de doublon -> lancement du code
'On sélectionne le calendrier
Set MyCalendar = OutlItems 'choix calendrier
'Fin choix calendrier
 
 
Module_màj.TextBox1.Visible = True
Set MyItem = MyCalendar.Add(olAppointmentItem)
 
   With MyItem 'inscription des données dans excel
        .MeetingStatus = olNonMeeting 'meeting
        .Subject = "De " & Cell.Offset(0, 6) & " à " & Cell.Offset(0, 7) & " - " & Cell.Offset(0, 1) & " - " & Cell.Offset(0, 3) & " - " & Cell.Offset(0, 4) 'Sujet
        .Start = Cell.Offset(0, 5) & " " & Cell.Offset(0, 6) 'Date et heure au format TEXTE
        .Duration = Cell.Offset(0, 8) 'durée du RDV en minute
        .Location = Cell.Offset(0, 2) 'emplacement
        '.AllDayEvent = Cell.Offset(0, 7) 'Toute la journée oui/non
        '.ReminderSet = Cell.Offset(0, 8) 'S'il y a un rappel
        '.ReminderMinutesBeforeStart = Cell.Offset(0, 10) 'Durée du rappel en minutes
        '.body = Cell.Offset(0, 9) 'Pour les commentaires ou sujets
        .Categories = Cell.Offset(0, 1) 'Sélection catégorie -> Attention, doivent être créées avant dans Outlook
        .Save
    End With
Set MyItem = Nothing
Module_màj.TextBox1.Visible = False
Else
GoTo Passe 'Si doublons existants passe à la date suivante
     Module_màj.TextBox1.Visible = False
     End If
 
 
  Else
     Cell = "" 'si la plage de données est vide on quitte la macro
     Module_màj.TextBox1.Visible = False
     Exit Sub
  End If
Passe:
Next Cell 'Relance macro jusqu'à épuisement RDV
 
End Sub

Ci-dessous, un aperçu du tableau :



Le problème que je rencontre est le suivant : je veux pouvoir faire des calculs d'heures. Mais, pour que la macro fonctionne, les dates et heures renseignées dans Excel doivent être au format texte ce qui rend les calculs, à mon sens, impossibles.

Est-il possible de modifier la macro pour qu'elle prenne les dates et heures aux formats idoines ou est-ce qu'il y aurait une possibilité de copier le contenu de la cellule "texte" et de la coller sur un autre onglet dans un format personnalisé ?

Merci d'avoir pris le temps de me lire et merci à celles et ceux qui se pencheront sur cette problématique.

Bien à vous,

Guy.

[Guy7700]

Bonjour à tous,

Après quelques recherches, j'ai trouvé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=CNUM(cellule)

pour copier les données et les mettre au format que je souhaite.

Le sujet est clos pour ma part