Bonjour les Amis,

Je viens vers vous car j'ai besoin d'aide pour convertir un code VBA en Office Script. Effectivement les fichier XLSM ne fonctionnent pas sur cloud....
Vous trouverez le code ci-dessous.

Alors voici comment fonctionne mon code, dans une feuille Excel j'ai variabilisé des chemins et récupéré des variable Windows via les formule pour les utiliser en VBA.

Je déclenche le code manuellement depuis le fichier Excel "Pilotage Pole graphique V4 -SharePoint.xlsm".

Le VBA ouvre un fichier Excel "Demande-DAO.xlsx" et récupère les valeurs de la feuille "Form1" pour écrire les valeurs sur la feuille "2024" du fichier Excel "Pilotage Pole graphique V4 -SharePoint.xlsm".

Ensuite en fonction de la ligne du tableau le code récupère un fichier, le renomme et le range dans le bon répertoire et envoie un mail à l'utilisateur qui à déposé le fichier via un formulaire Forms.

Je voulais automatisé le tous via Power Automate, et la solution la plus simple que j'ai trouvé est de convertir les macro vba en Office Scripte. De cette manière lorsque qu'un utilisateur envoie un réponses via Forms, Power Automate éxécute le script et écrit dans le fichier Excel "Pilotage Pole graphique V4 -SharePoint.xlsm".

Vous savez tout

Je ne connais pas du tout le OfficeScript... et je ne trouve pas ce dont j'ai besoin sur le web...

Je vous remercie d'avance pour votre aide


Voici mon code
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
 
 
Sub Recuperation_Des_Demndes()
'
'Code au format ISO A3 Paysage Notepad++
'------------------------------------------------------------------------------------------------------------------------
'Auteur :AMALLER Rémy                                                                                                   '
'                                                                                                                       '
'Date :09/04/2024                                                                                                       '
'                                                                                                                       '
'Propose : Codes pour récupérer les demandes CAO depuis le SharePointe et de renseigner le tableau de pilotage.         '
'                                                                                                                       '
'------------------------------------------------------------------------------------------------------------------------
'
'Références à activer----------------------------------------------------------------------------------------------------
'
'
'
'
'Déclarations des variables locales--------------------------------------------------------------------------------------
 
'Varible pour chercher dans windows
Dim Fso As Scripting.FileSystemObject
'Varible pour acceder au fichier Excel de récupération des réponses Forms
Dim Repertoire_OneDrive_Demande_CAO As Scripting.Folder
'Varible pour acceder au répertoir de récupération des fichiers chargés depuis Forms
Dim Repertoire_OneDrive_Demande_CAO_PIECES_JOINTES As Scripting.Folder
'Varible pour acceder au répertoir des pièces jointe traitées
Dim Repertoire_OneDrive_PIECES_JOINTES As Scripting.Folder
 
 
'Varible pour nom fichier Excel de récupération des réponses Forms
'Dim Fichier_Excel_Demandes_CAO As Scripting.File
Dim Fichier_Excel_Demandes_CAO As String
 
'Varible pour nom des pièces jointes
Dim Fichier_PIECES_JOINTES_Demandes_CAO As Scripting.File
Dim Fichier_PIECES_JOINTES_Demandes_CAO_STR As String
 
 
Dim Chemin_OneDrive_SharePoint_Fichier_Demandes As String
Dim Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO As String
Dim Chemin_OneDrive_SharePoint_Pieces_Jointes As String
 
Dim Hyperlink As String
 
 
'Variable Excel
Dim xlApp As Excel.Application
'Dim xlBook As Excel.Workbook
Dim Fichier_Pilotage As Excel.Workbook
Dim Fichier_Demande_CAO As Excel.Workbook
 
 
Dim Dernier_Cellule_Vide_Pilotage As Range
Dim Dernier_Cellule_Vide_Demandes_CAO As Range
Dim Plage_Cellule_PJ As Range
 
Dim Ligne_Vide_Pilotage As Integer
'Dim Ligne_Demande As Integer
 
Dim i As Integer 'compteur
Dim j As Integer 'compteur lignes
Dim Nombre_PJ As Integer
 
 
 
'Dim Nom_FichierExcel As String
'Dim Nom_FichierExcelDemandes As String
 
 
Dim Annee_En_Cours As String
 
 
'Variable pour barre de progression
Dim CurrentProgress As Double
Dim ProgressPercentage As Double
Dim BarWidth As Long
Dim CurrentProgress2 As Double
Dim ProgressPercentage2 As Double
Dim BarWidth2 As Long
 
'Variable OUTLOOK
 
 
'Fin des déclarations des variables locales------------------------------------------------------------------------------
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Set Fichier_Pilotage = ThisWorkbook
 
Fichier_Pilotage.Activate
 
Annee_En_Cours = Year(Now())
 
 
'Affectation des chemins et noms des variables déclarées dans EXCEL pour VBA---------------------------------------------
'
'Chemins
Chemin_OneDrive_SharePoint_Fichier_Demandes = _
Range("Excel_Chemin_OneDrive_SharePoint_Fichier_Demandes").Value
 
Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO = _
Range("Excel_Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO").Value
 
Chemin_OneDrive_SharePoint_Pieces_Jointes = _
Range("Excel_Chemin_OneDrive_SharePoint_Pieces_Jointes").Value
 
 
 
'Noms
Nom_FichierExcelDemandesCAO = Range("Excel_Nom_Fichier_Demandes").Value
 
 
'Instantiation  des variables scripting----------------------------------------------------------------------------------
'
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire_OneDrive_Demande_CAO = _
    Fso.GetFolder(Chemin_OneDrive_SharePoint_Fichier_Demandes)
 
Set Repertoire_OneDrive_Demande_CAO_PIECES_JOINTES = _
    Fso.GetFolder(Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO)
 
Set Repertoire_OneDrive_PIECES_JOINTES = Fso.GetFolder(Chemin_OneDrive_SharePoint_Pieces_Jointes)
 
 
'contrôle si le répertoire pour les pièces jointes existe
    If DossierExiste(Chemin_OneDrive_SharePoint_Pieces_Jointes & "\" & Annee_En_Cours) = True Then
        'On ne fait rien
    Else
        'Création du dossier
        MkDir (Chemin_OneDrive_SharePoint_Pieces_Jointes & "\" & Annee_En_Cours & "\")
    End If
 
 
 
 
 
 
''contrôle si le Classeur existe, vérifier s'il est déjà ouvert
'Verification = EstClasseurOuvert(Repertoire_OneDrive_Demande_CAO)
'
'    If Verification = False Then
'        MsgBox "ERREUR: Le Classeur: [(Repertoire_OneDrive_Demande_CAO] et fermé."
'        Bit_stop_USF = False
'        End
'    End If
 
 
'Ouvre le fichier Excel des demandes CAO
Set Fichier_Demande_CAO = Workbooks.Open(Repertoire_OneDrive_Demande_CAO & "\" & Nom_FichierExcelDemandesCAO)
 
    With Fichier_Demande_CAO.Sheets("Form1").Activate
        'Dernière cellule vide de la colonne 1
        Set Dernier_Cellule_Vide_Demandes_CAO = Cells(Cells.Columns.Count, 1).End(xlUp)
        j = Dernier_Cellule_Vide_Demandes_CAO.Row 'permet de récupérer le N° de ligne dans la variable j
    End With
 
    'Contrôle si des demandes Existent
    If j = 4 Then
        'Fermeture du fichier
        Fichier_Demande_CAO.Close
        'Vidage des variable
        Set Dernier_Cellule_Vide_Demandes_CAO = Nothing
        Set Fichier_Demande_CAO = Nothing
        Set Fichier_Pilotage = Nothing
        Set Repertoire_OneDrive_Demande_CAO = Nothing
        Set Repertoire_OneDrive_Demande_CAO_PIECES_JOINTES = Nothing
        Set Repertoire_OneDrive_PIECES_JOINTES = Nothing
        Set Fso = Nothing
        End
    End If
 
    With Fichier_Pilotage.Sheets(Annee_En_Cours).Activate
        Set Dernier_Cellule_Vide_Pilotage = Range("B" & Rows.Count).End(xlUp).End(xlUp).Offset(1, 0).Rows
        Ligne_Vide_Pilotage = Dernier_Cellule_Vide_Pilotage.Row
    End With
 
 
For j = 5 To j
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("B" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("B" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("C" & Ligne_Vide_Pilotage).Value = _
        UCase(Fichier_Demande_CAO.Sheets("Form1").Range("M" & j))
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("D" & Ligne_Vide_Pilotage).Value = _
        UCase(Fichier_Demande_CAO.Sheets("Form1").Range("N" & j))
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("F" & Ligne_Vide_Pilotage).Value = _
         UCase(Fichier_Demande_CAO.Sheets("Form1").Range("O" & j))
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("G" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("J" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("H" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("K" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("I" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("P" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("J" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("F" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("K" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("R" & j)
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("L" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("Q" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("BO" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("D" & j)
 
    Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("N" & Ligne_Vide_Pilotage).Value = _
        Fichier_Demande_CAO.Sheets("Form1").Range("G" & j)
 
    'Type de plan voulez-vous mettre à jour (Type Document)
    Select Case Fichier_Demande_CAO.Sheets("Form1").Range("H" & j).Value
        Case "PID"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("O" & Ligne_Vide_Pilotage).Value = "Chimique"
        Case "Infrastructure (plan usine, bâtiments)"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("O" & Ligne_Vide_Pilotage).Value = "Infra"
        Case "Electricité"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("O" & Ligne_Vide_Pilotage).Value = "Elec"
        Case "Sécurité (AEAI, SIS, QHSE...)"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("O" & Ligne_Vide_Pilotage).Value = "Secu"
    End Select
 
    'Type de document voulez-vous mettre à jour (Sous-ype Document)
    Select Case Fichier_Demande_CAO.Sheets("Form1").Range("I" & j).Value
        Case "Electrique (liste de départs, schéma)"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("P" & Ligne_Vide_Pilotage).Value = "Schéma"
        Case "Electrique (schéma de principe, implantation EA, luminaire...)"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("P" & Ligne_Vide_Pilotage).Value = "Infra"
 
    End Select
 
    'Type de travail
    Select Case Fichier_Demande_CAO.Sheets("Form1").Range("L" & j).Value
        Case "Création"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("M" & Ligne_Vide_Pilotage).Value = "Création"
        Case "Mise à jour"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("M" & Ligne_Vide_Pilotage).Value = "MàJ"
        Case "Conversion"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("M" & Ligne_Vide_Pilotage).Value = "Conversion"
        Case "Suppression"
            Workbooks(Fichier_Pilotage.Name).Sheets(Annee_En_Cours).Range("M" & Ligne_Vide_Pilotage).Value = "Supp"
    End Select
 
 
    'Gestion des pièces jointes
        With Fichier_Demande_CAO.Sheets("Form1").Activate
            'Set Plage_Cellule_PJ = Range("S" & j & ":" & "U" & j)
            Set Plage_Cellule_PJ = Range(Cells(j, 19), Cells(j, 21))
        End With
 
        Nombre_PJ = 0
        'Contrôle si plusieures PJ sur même ligne alors créer un répertoire avec N°de tache et PID
        For Each Cel In Plage_Cellule_PJ
            If Cel.Value <> "" Then
                Nombre_PJ = Nombre_PJ + 1
            End If
        Next Cel
 
        If Nombre_PJ = 0 Then
 
            'Rien faire
 
        ElseIf Nombre_PJ >= 1 Then
 
            'Nombre_PJ = 3
            For i = 0 To Nombre_PJ - 1
 
                    'Rcupération du chemin complet fourni par Forms
                    Fichier_PIECES_JOINTES_Demandes_CAO_STR = _
                        Fichier_Demande_CAO.Sheets("Form1").Cells(j, 19 + i).Value
 
                    'Fichier_PIECES_JOINTES_Demandes_CAO_STR = Fichier_Demande_CAO.Sheets("Form1").Range("S" & j).Value
                    'Supprime les caractères avant le dernier caratère"/"
                    Fichier_PIECES_JOINTES_Demandes_CAO_STR = _
                        (Mid(Fichier_PIECES_JOINTES_Demandes_CAO_STR, _
                        InStrRev(Fichier_PIECES_JOINTES_Demandes_CAO_STR, "/")))
 
                    'Supprime le PREMIER caractère de la chaine. Ici c'est le caractère: /
                    Fichier_PIECES_JOINTES_Demandes_CAO_STR = _
                        Right(Fichier_PIECES_JOINTES_Demandes_CAO_STR, Len(Fichier_PIECES_JOINTES_Demandes_CAO_STR) - 1)
 
                    'Remplace le%20 par un espace
                    Fichier_PIECES_JOINTES_Demandes_CAO_STR = _
                        Replace(Fichier_PIECES_JOINTES_Demandes_CAO_STR, "%20", " ")
 
 
                    'Nouveau nom pour le fichier
                    PJ_Nouveau_Non = Ligne_Vide_Pilotage & "-" & Format(Fichier_Demande_CAO.Sheets("Form1") _
                                    .Range("B" & j).Value, "YYYYMMDD") & " - " & Fichier_PIECES_JOINTES_Demandes_CAO_STR
 
 
                    'Selection du fichier à renommer
                    Set Fichier_PIECES_JOINTES_Demandes_CAO = Fso.GetFile(Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO _
                                                              & "\" & Fichier_PIECES_JOINTES_Demandes_CAO_STR)
 
                    'Renommer le fichier
                    Fichier_PIECES_JOINTES_Demandes_CAO.Name = PJ_Nouveau_Non
 
                    'Vide la variable
                    Set Fichier_PIECES_JOINTES_Demandes_CAO = Nothing
 
                    'Selection du fichier à déplacer
                    Set Fichier_PIECES_JOINTES_Demandes_CAO = Fso.GetFile(Chemin_OneDrive_SharePoint_Pieces_Jointes_Demandes_CAO _
                                                              & "\" & PJ_Nouveau_Non)
 
                        If Nombre_PJ = 1 Then
 
                            'Déplacement du fichier
                            Fichier_PIECES_JOINTES_Demandes_CAO.Move (Chemin_OneDrive_SharePoint_Pieces_Jointes & _
                                                              "\" & Annee_En_Cours & "\")
 
                            'Vide la variable
                            Set Fichier_PIECES_JOINTES_Demandes_CAO = Nothing
 
                            'Faire lien hypertext dans fichier pilotage
                            'Remonter dans les répertoire
                            Hyperlink = RemonterNiveauRepertoire(Fichier_Demande_CAO.Sheets("Form1").Cells(j, 19 + i).Value, 5, "/")
                            'Descendre au répertoire des mise à jour renommée
                            Hyperlink = Hyperlink & "General/MISES-A-JOURS/" & Annee_En_Cours & "/"
 
                            'Remplace les espaces par %20
                            'PJ_Nouveau_Non = Replace(PJ_Nouveau_Non, " ", "%20")
 
                            Hyperlink = Hyperlink & PJ_Nouveau_Non
 
                        ElseIf Nombre_PJ > 1 Then
 
                            'Création du répertoire des pièce jointes liées à la tâche
                            Dim Repertoire_Plusieurs_PJ As String
 
                            Repertoire_Plusieurs_PJ = Chemin_OneDrive_SharePoint_Pieces_Jointes & "\" _
                                                      & Annee_En_Cours & "\" & Ligne_Vide_Pilotage & "-" _
                                                      & Format(Fichier_Demande_CAO.Sheets("Form1"). _
                                                      Range("B" & j).Value, "YYYYMMDD")
 
                                'contrôle si le répertoire pour les pièces jointes existe
                                If DossierExiste(Repertoire_Plusieurs_PJ & "\") = True Then
                                    'On ne fait rien
                                Else
                                    'Création du répertoire
                                    MkDir (Repertoire_Plusieurs_PJ & "\")
 
                                End If
 
                            'Déplacement du fichier
                            Fichier_PIECES_JOINTES_Demandes_CAO.Move (Repertoire_Plusieurs_PJ & "\")
 
                            'Faire lien hypertext du répertoire dans fichier pilotage
                            'Remonter dans les répertoire
                            Hyperlink = RemonterNiveauRepertoire(Fichier_Demande_CAO.Sheets("Form1").Cells(j, 19 + i).Value, 5, "/")
                            'MsgBox Hyperlink
                            'Remplace le%20 par un espace
                             Hyperlink = Replace(Hyperlink, "%20", " ")
 
                            'MsgBox Hyperlink
 
 
                            'Descendre au répertoire des mise à jour renommée
                            Hyperlink = Hyperlink & "General/MISES-A-JOURS/" & Annee_En_Cours & "/" & Ligne_Vide_Pilotage & "-" _
                                                      & Format(Fichier_Demande_CAO.Sheets("Form1"). _
                                                      Range("B" & j).Value, "YYYYMMDD") & "/"
 
                            'MsgBox Hyperlink
                            End If
 
                    Hyperlink = AssainirURL(Hyperlink)
                    '"https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General/MISES-A-JOURS/2024"
 
                    With Fichier_Pilotage.Sheets(Annee_En_Cours).Activate
                        Fichier_Pilotage.Sheets(Annee_En_Cours).Hyperlinks.Add Anchor:=Range("A" & Ligne_Vide_Pilotage), _
                        Address:=Hyperlink
                    End With
            Next i
        End If
 
 
 
    'Faire mail Automatique demandes enregistrées
'------------------------------------------------------------------------------------------------------------------------
'Déclaration des variable
Dim MaMessagerie As Object
Dim MonMessage As Object
Dim MaSignature As String
Dim Destinataire As String
Dim Destinataire_Copie As String
Dim Destinataire_Copie_Cache As String
Dim Objet_Du_Mail As String
 
    'Récupère l'adresse mail du destinataire
    With Fichier_Demande_CAO.Sheets("Form1").Activate
        Destinataire = Fichier_Demande_CAO.Sheets("Form1").Range("D" & j)
    End With
 
    'Création de l'objet du mail
    'Tache N° : 226 - LP440100-EA200001 - ARM.034-440 - WOxxxxxxx
    With Fichier_Pilotage.Sheets(Annee_En_Cours).Activate
        'Crontrôle si plan avec N° Armoire
        If Range("G" & Ligne_Vide_Pilotage).Value = "" Then
 
            Objet_Du_Mail = "Demande CAO enregistrée - Tâche N° : " _
            & Ligne_Vide_Pilotage & " - " _
            & Range("E" & Ligne_Vide_Pilotage).Value & " - " _
            & Range("L" & Ligne_Vide_Pilotage).Value
        Else
 
            Objet_Du_Mail = "Demande CAO enregistrée - Tâche N° : " _
            & Ligne_Vide_Pilotage & " - " _
            & Range("E" & Ligne_Vide_Pilotage).Value & " - ARM. " _
            & Range("G" & Ligne_Vide_Pilotage).Value & " - " _
            & Range("L" & Ligne_Vide_Pilotage).Value
 
        End If
    End With
 
 
'Affectation des variables de type objet
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
 
'Affiche le mail
MonMessage.Display
'Récupère la signature
MaSignature = MonMessage.HTMLBody
 
'Construction message
With MonMessage
    '.To = "#FIRSA.LP.POLE.GRAPHIQUE@firmenich.com" 'Mail
    .To = Destinataire
    '.CC = "#FIRSA.LP.POLE.GRAPHIQUE@firmenich.com" '"Les adresses des personnes en copy conforme"
    '.CC = MaMessagerie.GetNamespace("MAPI").CurrentUser
    '.CCi "Les adresses des personnes en copy conforme invisible"
 
    'Objet du mail
    .Subject = Objet_Du_Mail
    'Affiche le corps du mails
    .HTMLBody = "Bonjour," & "<br></br><br></br>" & _
                    "La demande a été enregistrée sous la tâche N° " & Ligne_Vide_Pilotage & " du fichier de pilotage Pôle graphique. Nous traiterons la demande dans les meilleurs délais. " & "<br></br>" & _
                    "Vous pouvez voir l'avancement du travail dans le fichier Pilotage Pole graphique V4 -SharePoint - VISU.xlsm en cliquant sur le lien ci-dessous." & "<br></br>" & "<br></br>" & _
                    "<FONT color=""red"">" & "/!\ Tant que la migration des sessions Windows en dsm-firmenich n'est pas faite, copier le lien dans une fenêtre de navigation privée d'un navigateur web /!\" & "<br></br>" & _
                    "Vous trouverez en pièce jointe une quick card pour vous connecter à votre compte MSO365 dsm-firmenich." & "</FONT>" & "<br></br>" & "<br></br>" & _
                    "https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General" & "<br></br>" & "<br></br>" & _
                    "Voici le lien où sont classées les mises à jour :" & "<br></br>" & "<br></br>" & _
                    "https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General/MISES-A-JOURS/" & Annee_En_Cours & "" & "<br></br>" & "<br></br>" & _
                    "Bonne  journée." & "<br></br>" & _
                    "Cordialement." & "<br></br>" & _
                    "Le Pôle Graphique." & "<br></br>" & _
                    "RÉMY" & "<br></br>" & _
                    "7471"
 
'    .HTMLBody = "Bonjour," & "<br></br><br></br>" & _
'                    "La demande a été enregistrée sous la tâche N° " & Ligne_Vide_Pilotage & " du fichier de pilotage Pôle graphique. Nous traiterons la demande dans les meilleurs délais. " & "<br></br>" & _
'                    "Vous pouvez voir l'avancement du travail dans le fichier Pilotage Pole graphique V4 -SharePoint - VISU.xlsm en cliquant sur le lien ci-dessous." & "<br></br>" & "<br></br>" & _
'                    "<FONT color=""red"">" & "/!\ Tant que la migration des sessions Windows en dsm-firmenich n'est pas faite, copier le lien dans une fenêtre de navigation privée d'un navigateur web /!\" & "</FONT>" & "<br></br>" & "<br></br>" & _
'                    "<p><a href=""https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General"">https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General</a></p>" & "<br></br>" & _
'                    "Voici le lien où sont classées les mises à jour :" & "<br></br>" & _
'                    "<p><a href=""https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General/MISES-A-JOURS/" & Annee_En_Cours & """>https://dsm1234.sharepoint.com/sites/POLEGRAPHIQUE-LAPLAINE/Shared%20Documents/General/MISES-A-JOURS/2024</a></p>" & "<br></br>" & _
'                    "Bonne  journée." & "<br></br>" & _
'                    "Cordialement." & "<br></br>" & _
'                    "Le Pôle Graphique." & "<br></br>" & _
'                    "RÉMY" & "<br></br>" & _
'                    "7471"
    '"Vous trouverez en pièce jointe une Quick Card pour vous connecter à MS365 et accèder au SharePoint." & "<br></br>" & "<br></br>" & _
 
    'Insertion du fichier
    .Attachments.Add (Chemin_OneDrive_SharePoint_Fichier_Demandes & "\" & "Quick Card - Access SharePoint Pole Graphique.pdf")
 
    .Send
 
End With
 
Set MonMessage = Nothing
Set MaMessagerie = Nothing
 
 
 
    Ligne_Vide_Pilotage = Ligne_Vide_Pilotage + 1
Next j
 
'Vidage des variable
Set Dernier_Cellule_Vide_Demandes_CAO = Nothing
Set Fichier_Demande_CAO = Nothing
Set Fichier_Pilotage = Nothing
Set Repertoire_OneDrive_Demande_CAO = Nothing
Set Repertoire_OneDrive_Demande_CAO_PIECES_JOINTES = Nothing
Set Repertoire_OneDrive_PIECES_JOINTES = Nothing
Set Fso = Nothing
 
ScreenUpdating = True
DisplayAlerts = True
 
End Sub
 
Function DossierExiste(MonDossier As String)
'
'DossierExiste(Chemin_OneDrive_SharePoint_Pieces_Jointes & "\" & Annee_En_Cours)
'DossierExiste("C:\Users\RYLL\OneDrive - dsm-firmenich\Documents")
'
   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function
 
Public Function RemonterNiveauRepertoire(NomRep As String, NbNiveau As Integer, separateur As String) As String
    Dim i As Integer
    Dim NbExec As Integer
 
    For i = Len(NomRep) - 1 To 1 Step -1
        If Mid(NomRep, i, 1) = separateur Then
            NbExec = NbExec + 1
            If NbExec = NbNiveau Then RemonterNiveauRepertoire = Left(NomRep, i)
        End If
    Next i
End Function
 
Public Function AssainirURL(MonURL As String)
'par Excel-Malin.com ( https://excel-malin.com )
 
On Error GoTo FonctionErreur
 
Dim URLtemporaire As String
 
URLtemporaire = MonURL
URLtemporaire = Replace(URLtemporaire, "%", "%25")
URLtemporaire = Replace(URLtemporaire, " ", "%20")
URLtemporaire = Replace(URLtemporaire, """", "%22")
URLtemporaire = Replace(URLtemporaire, "#", "%23")
URLtemporaire = Replace(URLtemporaire, "$", "%24")
URLtemporaire = Replace(URLtemporaire, "&", "%26")
URLtemporaire = Replace(URLtemporaire, "'", "%27")
URLtemporaire = Replace(URLtemporaire, "(", "%28")
URLtemporaire = Replace(URLtemporaire, ")", "%29")
URLtemporaire = Replace(URLtemporaire, "*", "%2A")
URLtemporaire = Replace(URLtemporaire, "+", "%2B")
URLtemporaire = Replace(URLtemporaire, ",", "%2C")
URLtemporaire = Replace(URLtemporaire, ";", "%3B")
URLtemporaire = Replace(URLtemporaire, "<", "%3C")
URLtemporaire = Replace(URLtemporaire, "=", "%3D")
URLtemporaire = Replace(URLtemporaire, ">", "%3E")
URLtemporaire = Replace(URLtemporaire, "?", "%3F")
URLtemporaire = Replace(URLtemporaire, "@", "%40")
URLtemporaire = Replace(URLtemporaire, "[", "%5B")
URLtemporaire = Replace(URLtemporaire, "]", "%5D")
URLtemporaire = Replace(URLtemporaire, "^", "%5E")
URLtemporaire = Replace(URLtemporaire, "`", "%60")
URLtemporaire = Replace(URLtemporaire, "{", "%7B")
URLtemporaire = Replace(URLtemporaire, "|", "%7C")
URLtemporaire = Replace(URLtemporaire, "}", "%7D")
URLtemporaire = Replace(URLtemporaire, "~", "%7E")
URLtemporaire = Replace(URLtemporaire, "¢", "%A2")
URLtemporaire = Replace(URLtemporaire, "£", "%A3")
URLtemporaire = Replace(URLtemporaire, "¥", "%A5")
URLtemporaire = Replace(URLtemporaire, "|", "%A6")
URLtemporaire = Replace(URLtemporaire, "§", "%A7")
URLtemporaire = Replace(URLtemporaire, "«", "%AB")
URLtemporaire = Replace(URLtemporaire, "¬", "%AC")
URLtemporaire = Replace(URLtemporaire, "¯", "%AD")
URLtemporaire = Replace(URLtemporaire, "º", "%B0")
URLtemporaire = Replace(URLtemporaire, "±", "%B1")
URLtemporaire = Replace(URLtemporaire, "ª", "%B2")
URLtemporaire = Replace(URLtemporaire, ",", "%B4")
URLtemporaire = Replace(URLtemporaire, "µ", "%B5")
URLtemporaire = Replace(URLtemporaire, "»", "%BB")
URLtemporaire = Replace(URLtemporaire, "¼", "%BC")
URLtemporaire = Replace(URLtemporaire, "½", "%BD")
URLtemporaire = Replace(URLtemporaire, "¿", "%BF")
URLtemporaire = Replace(URLtemporaire, "À", "%C0")
URLtemporaire = Replace(URLtemporaire, "Á", "%C1")
URLtemporaire = Replace(URLtemporaire, "Â", "%C2")
URLtemporaire = Replace(URLtemporaire, "Ã", "%C3")
URLtemporaire = Replace(URLtemporaire, "Ä", "%C4")
URLtemporaire = Replace(URLtemporaire, "Å", "%C5")
URLtemporaire = Replace(URLtemporaire, "Æ", "%C6")
URLtemporaire = Replace(URLtemporaire, "Ç", "%C7")
URLtemporaire = Replace(URLtemporaire, "È", "%C8")
URLtemporaire = Replace(URLtemporaire, "É", "%C9")
URLtemporaire = Replace(URLtemporaire, "Ê", "%CA")
URLtemporaire = Replace(URLtemporaire, "Ë", "%CB")
URLtemporaire = Replace(URLtemporaire, "Ì", "%CC")
URLtemporaire = Replace(URLtemporaire, "Í", "%CD")
URLtemporaire = Replace(URLtemporaire, "Î", "%CE")
URLtemporaire = Replace(URLtemporaire, "Ï", "%CF")
URLtemporaire = Replace(URLtemporaire, "Ð", "%D0")
URLtemporaire = Replace(URLtemporaire, "Ñ", "%D1")
URLtemporaire = Replace(URLtemporaire, "Ò", "%D2")
URLtemporaire = Replace(URLtemporaire, "Ó", "%D3")
URLtemporaire = Replace(URLtemporaire, "Ô", "%D4")
URLtemporaire = Replace(URLtemporaire, "Õ", "%D5")
URLtemporaire = Replace(URLtemporaire, "Ö", "%D6")
URLtemporaire = Replace(URLtemporaire, "Ø", "%D8")
URLtemporaire = Replace(URLtemporaire, "Ù", "%D9")
URLtemporaire = Replace(URLtemporaire, "Ú", "%DA")
URLtemporaire = Replace(URLtemporaire, "Û", "%DB")
URLtemporaire = Replace(URLtemporaire, "Ü", "%DC")
URLtemporaire = Replace(URLtemporaire, "Ý", "%DD")
URLtemporaire = Replace(URLtemporaire, "Þ", "%DE")
URLtemporaire = Replace(URLtemporaire, "ß", "%DF")
URLtemporaire = Replace(URLtemporaire, "à", "%E0")
URLtemporaire = Replace(URLtemporaire, "á", "%E1")
URLtemporaire = Replace(URLtemporaire, "â", "%E2")
URLtemporaire = Replace(URLtemporaire, "ã", "%E3")
URLtemporaire = Replace(URLtemporaire, "ä", "%E4")
URLtemporaire = Replace(URLtemporaire, "å", "%E5")
URLtemporaire = Replace(URLtemporaire, "æ", "%E6")
URLtemporaire = Replace(URLtemporaire, "ç", "%E7")
URLtemporaire = Replace(URLtemporaire, "è", "%E8")
URLtemporaire = Replace(URLtemporaire, "é", "%E9")
URLtemporaire = Replace(URLtemporaire, "ê", "%EA")
URLtemporaire = Replace(URLtemporaire, "ë", "%EB")
URLtemporaire = Replace(URLtemporaire, "ì", "%EC")
URLtemporaire = Replace(URLtemporaire, "í", "%ED")
URLtemporaire = Replace(URLtemporaire, "î", "%EE")
URLtemporaire = Replace(URLtemporaire, "ï", "%EF")
URLtemporaire = Replace(URLtemporaire, "ð", "%F0")
URLtemporaire = Replace(URLtemporaire, "ñ", "%F1")
URLtemporaire = Replace(URLtemporaire, "ò", "%F2")
URLtemporaire = Replace(URLtemporaire, "ó", "%F3")
URLtemporaire = Replace(URLtemporaire, "ô", "%F4")
URLtemporaire = Replace(URLtemporaire, "õ", "%F5")
URLtemporaire = Replace(URLtemporaire, "ö", "%F6")
URLtemporaire = Replace(URLtemporaire, "÷", "%F7")
URLtemporaire = Replace(URLtemporaire, "ø", "%F8")
URLtemporaire = Replace(URLtemporaire, "ù", "%F9")
URLtemporaire = Replace(URLtemporaire, "ú", "%FA")
URLtemporaire = Replace(URLtemporaire, "û", "%FB")
URLtemporaire = Replace(URLtemporaire, "ü", "%FC")
URLtemporaire = Replace(URLtemporaire, "ý", "%FD")
URLtemporaire = Replace(URLtemporaire, "þ", "%FE")
URLtemporaire = Replace(URLtemporaire, "ÿ", "%FF")
 
AssainirURL = URLtemporaire
Exit Function
 
FonctionErreur:
AssainirURL = CVErr(xlErrValue)
 
End Function