VBA convertir en Office Script

Version imprimable

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 :D

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

Je vous remercie d'avance pour votre aide8-):ccool:

Voici mon code

Code:

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

Salut,

faire du code ligne à ligne entre VBA et Office Script est une mauvaise piste.

Il faudra déterminer les grandes étapes de ton code.

La combinaison Power Automate et Office Script reste une bonne idée.

Par exemple, les lignes
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 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
devra se faire dans un flux Power Automate.

Il va falloir découper tout cela

Un éléphant entier, ca se mange, une cuiller à la fois.

VBA convertir en Office Script

Bonjour Les Amis,

J'ai essayé.... je n'y arrive pas...

En revue les grand lignes de mon codes qui se compose des étape suivantes:

1. Récupérer les réponses du formulaire Forms => je pourrais le faire avec power automate
2. Renommer les pièces jointes en fonction de la lignes inscrite (ajout du n° de tache et le l'index)
3. Déplacer les pièces joint dans le répertoire de destination
4. Faire le lien de la pièce jointe avec le nuéro de tache (cellule de la ligne en cour de la colonne A)

J'ai une fonction VBA que j'utilise en MEC avec une formule, je n'arrive pas à la convertir en OFFICEScript, j'ai demandé à Chat GPT de me la convertir mais cela ne fonctionne pas comme voulu....

Voici la fonction:

Code:

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
 
 
Function DoublonEntre3FeuillesAvecCriteres(Feuille1 As String, Cellule_Recherche_Feuille1 As Range, Plage_Recherche_Feuille1 As Range, Cellule_Critere_Feuille1 As Range, _
                    Plage_Critere_Feuille1 As Range, critere1_1 As Variant, critere1_2 As Variant, _
                    Feuille2 As String, Plage_Recherche_Feuille2 As Range, Plage_Critere_Feuille2 As Range, _
                    Feuille3 As String, Plage_Recherche_Feuille3 As Range, Plage_Critere_Feuille3 As Range) As Boolean
 
'formule pour Excel : =DoublonEntre3FeuillesAvecCriteres("2021";E7;$E$7:$E$600;P7;$P$7:$P$600;"<>soldé";"<>annulé";"2023";$E$7:$E$600;$U$7:$U$600;"2024";$E$7:$E$600;$U$7:$U$600)
 
 
'Cette fonction renvoie le résultat pour la feuille 1 c'est à dire qu' il faut mettre la feuille où on utilise cette fonction en premier dans les arguments.
 
 
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer
Dim Bit1 As Boolean 'Bit pour table vérité
Dim Bit2 As Boolean ' Bit pour table vérité
Dim Bit3 As Boolean 'Bit pour table vérité
Dim CheckSomme As Boolean 'Bit final
 
Macro_En_Cours = True
 
    ' Compter sur la feuille Feuille1
    count1 = WorksheetFunction.CountIfs(ThisWorkbook.Sheets(Feuille1).Range(Plage_Recherche_Feuille1.Address), Cellule_Recherche_Feuille1.Value, ThisWorkbook.Sheets(Feuille1).Range(Plage_Critere_Feuille1.Address), critere1_1, ThisWorkbook.Sheets(Feuille1).Range(Plage_Critere_Feuille1.Address), critere1_2)
 
    ' Compter sur la feuille Feuille2
    count2 = WorksheetFunction.CountIfs(ThisWorkbook.Sheets(Feuille2).Range(Plage_Recherche_Feuille2.Address), Cellule_Recherche_Feuille1.Value, ThisWorkbook.Sheets(Feuille2).Range(Plage_Critere_Feuille2.Address), critere1_1, ThisWorkbook.Sheets(Feuille2).Range(Plage_Critere_Feuille2.Address), critere1_2)
 
    ' Compter sur la feuille Feuille3
    count3 = WorksheetFunction.CountIfs(ThisWorkbook.Sheets(Feuille3).Range(Plage_Recherche_Feuille3.Address), Cellule_Recherche_Feuille1.Value, ThisWorkbook.Sheets(Feuille3).Range(Plage_Critere_Feuille3.Address), critere1_1, ThisWorkbook.Sheets(Feuille3).Range(Plage_Critere_Feuille3.Address), critere1_2)
 
    'Mise à 0 des bit
    Bit1 = False
    Bit2 = False
    Bit3 = False
 
    'Mise à 1 des bit 'Bit pour table vérité suivant condition (Valeur >1 dans la feuille)
    If count1 >= 1 Then Bit1 = True
    If count2 >= 1 Then Bit2 = True
    If count3 >= 1 Then Bit3 = True
 
    'Calcul du bit final en fonction de la table de vérité des doublons
    If Bit1 = False And Bit2 = False And Bit3 = False Then CheckSomme = False
    If Bit1 = False And Bit2 = False And Bit3 = True Then CheckSomme = False
    If Bit1 = False And Bit2 = True And Bit3 = False Then CheckSomme = False
    If Bit1 = False And Bit2 = True And Bit3 = True Then CheckSomme = True
    If Bit1 = True And Bit2 = False And Bit3 = False Then CheckSomme = False
    If Bit1 = True And Bit2 = False And Bit3 = True Then CheckSomme = True
    If Bit1 = True And Bit2 = True And Bit3 = False Then CheckSomme = True
    If Bit1 = True And Bit2 = True And Bit3 = True Then CheckSomme = True
 
    If CheckSomme = True And (Cellule_Critere_Feuille1.Value <> critere1_1 And Cellule_Critere_Feuille1.Value <> critere1_2) Then
        DoublonEntre3FeuillesAvecCriteres = True
    Else
        DoublonEntre3FeuillesAvecCriteres = False
    End If
 
Macro_En_Cours = False
 
End Function

Voici la formule en MEC

Code:

1
2
 
=DoublonEntre3FeuillesAvecCriteres("2021";E7;$E$7:$E$254;P7;$P$7:$P$254;"<>soldé";"<>annulé";"2023";$E$7:$E$254;$U$7:$U$254;"2024";$E$7:$E$254;$U$7:$U$254)

Voici la formule utilisé dans une cellule Excel

Code:

1
2
 
=DoublonEntre3FeuillesAvecCriteres("2021";E113;$E$7:$E$254;P133;$P$7:$P$254;"<>soldé";"<>annulé";"2023";$E$7:$E$254;$U$7:$U$254;"2024";$E$7:$E$254;$U$7:$U$254)

Je vous remercie d'avance pour votre aide:D

18/06/2024, 11h28
Rémy.A

[XL-365] VBA convertir en Office Script

Apparemment tout le monde s'en fou....
Ce n'est plus ce c’était de forum
18/06/2024, 12h22
Pierre Dumas

Bonjour

Peut-être que peu de personnes ont les compétences et que ceux-ci préfère ne rien écrire que d'écrire des inepties ou des évidences.

Peut-être qu'il y a moins de gens qui sont prêt à aider les autres.

Peut-être qu'il y a plus de personnes qui posent plus de questions qu'ils n'apportent de réponses ou de partages d'expérience.

Peut-être qu'en fin d'année scolaire les gens ont moins de disponibilités.

Peut-être que le sujet intéresse moins.

Peut-être un peu de tout ça et d'autres choses aussi, mais je trouve la dernière remarque blessante pour ceux qui s'investissent régulièrement. Pas certain que cela les aide à rester motivés.

Pierre Dumas

Salut,

que te propose le robot comme code Office Script équivalent, on peut tenter de partir de là.

pour une mise en forme conditionnelle, tu as des exemples dans la doc MS : https://learn.microsoft.com/fr-fr/of...atting-samples

Dans ton VBA, tu aurais pu simplifier
'Mise à 1 des bit 'Bit pour table vérité suivant condition (Valeur >1 dans la feuille)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
    If count1 >= 1 Then Bit1 = True
    If count2 >= 1 Then Bit2 = True
    If count3 >= 1 Then Bit3 = True
 
    'Calcul du bit final en fonction de la table de vérité des doublons
    If Bit1 = False And Bit2 = False And Bit3 = False Then CheckSomme = False
    If Bit1 = False And Bit2 = False And Bit3 = True Then CheckSomme = False
    If Bit1 = False And Bit2 = True And Bit3 = False Then CheckSomme = False
    If Bit1 = False And Bit2 = True And Bit3 = True Then CheckSomme = True
    If Bit1 = True And Bit2 = False And Bit3 = False Then CheckSomme = False
    If Bit1 = True And Bit2 = False And Bit3 = True Then CheckSomme = True
    If Bit1 = True And Bit2 = True And Bit3 = False Then CheckSomme = True
    If Bit1 = True And Bit2 = True And Bit3 = True Then CheckSomme = True

avec un pragmatique

Code:

1
2
3
4
5
6
7
'Mise à 1 des bit 'Bit pour table vérité suivant condition (Valeur >1 dans la feuille)
    If count1 >= 1 Then Bit1 = 1
    If count2 >= 1 Then Bit2 = 1
    If count3 >= 1 Then Bit3 = 1
 
    'Calcul du bit final en fonction de la table de vérité des doublons
CheckSomme = Bit1+Bit2+Bit3>=2

18/06/2024, 18h19
Rémy.A

[XL-365] VBA convertir en Office Script

Citation:

Envoyé par Pierre Dumas

Bonjour

Peut-être que peu de personnes ont les compétences et que ceux-ci préfère ne rien écrire que d'écrire des inepties ou des évidences.

Peut-être qu'il y a moins de gens qui sont prêt à aider les autres.

Peut-être qu'il y a plus de personnes qui posent plus de questions qu'ils n'apportent de réponses ou de partages d'expérience.

Peut-être qu'en fin d'année scolaire les gens ont moins de disponibilités.

Peut-être que le sujet intéresse moins.

Peut-être un peu de tout ça et d'autres choses aussi, mais je trouve la dernière remarque blessante pour ceux qui s'investissent régulièrement. Pas certain que cela les aide à rester motivés.

Pierre Dumas

Bonjour Pierre,

Oui c'est vrai tu as raison, je m'excuse pour ce que j'ai écris. Quand j'ai écris le message, j'était énervé à la base (rien a voir avec ce sujet) et pas de réponse est une réponse.

Merci Jean-Philippe André pour ta réponse j'ai vraiment besoin d'aide pour officescript...
Si j'ai bien compris le OfficeScript c'est du JAVA

Encore désolé pour les remarques
18/06/2024, 22h42
Jean-Philippe André

Salut,
C'est du TypeScript, mais c'est accessoire comme info :)

As-tu essayé d'utiliser "l'enregistreur de macro" de Office Script pour les histoires de countif ?

C'est pas mal tricky ton affaire, on peut essayer dans un premier temps de changer les types de tes paramètres d'entrée:

Le range s'obtient avec un getRange("A1"), donc les cellules sont en fait des chaînes de caractères.

le countif à rallonge, tu peux me l'.expliquer en quelques mots, pas vraiment le temps de le decomposer bord à bord stp.

Voir des exemples ici : https://learn.microsoft.com/fr-fr/of...unt-blank-rows

tu peux voir la facon de boucler sur une série de lignes.

4 pièce(s) jointe(s)

[XL-365] VBA convertir en Office Script

Citation:

Envoyé par Jean-Philippe André

Salut,
C'est du TypeScript, mais c'est accessoire comme info :)

As-tu essayé d'utiliser "l'enregistreur de macro" de Office Script pour les histoires de countif ?

C'est pas mal tricky ton affaire, on peut essayer dans un premier temps de changer les types de tes paramètres d'entrée:

Le range s'obtient avec un getRange("A1"), donc les cellules sont en fait des chaînes de caractères.

le countif à rallonge, tu peux me l'.expliquer en quelques mots, pas vraiment le temps de le decomposer bord à bord stp.

Voir des exemples ici : https://learn.microsoft.com/fr-fr/of...unt-blank-rows

tu peux voir la facon de boucler sur une série de lignes.

Bonjour Jean-Philippe André,

Dans mon travail je reçois des mise à jour de schémas électriques, c'est mises à jour je les écris dans Excel.
Une feuille par année.

Elles sont classées dans un tableau et 1 ligne du tableau correspond à une mise à jour à faire.
Les mise à jour sont identifiées par le numéro de schéma.
Dans le tableau il y a une colonne état pour savoir si la mise à jour est faite.

La fonction permet de compter les numéros de schémas identiques en fonction de 2 critère ("<>soldé" ou "<>annulé" )de la colonne Etat sur les trois feuilles

La fonction renvoie vrai ou faux comme résultat et j'utilise la mise en forme conditionnelle pour colorier la cellule en orange

Pièce jointe 656227

Pièce jointe 656225

Pièce jointe 656226

Je peux aussi l'utiliser dans une cellule excel (colonne BO)

Pièce jointe 656228

J'avais commencé avec chat GPT et il m'a fourni ce code

Code:

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
 
function main(
    workbook: ExcelScript.Workbook,
    feuille1: string,
    plageControleeFeuille1: string,
    plageRechercheFeuille1: string,
    plageCritereFeuille1: string,
    critere1_1: string,
    critere1_2: string,
    feuille2: string,
    plageRechercheFeuille2: string,
    plageCritereFeuille2: string,
    feuille3: string,
    plageRechercheFeuille3: string,
    plageCritereFeuille3: string,
    colonneResultat: string
) {
    // Accéder aux feuilles
    let ws1 = workbook.getWorksheet(feuille1);
    let ws2 = workbook.getWorksheet(feuille2);
    let ws3 = workbook.getWorksheet(feuille3);
 
    // Récupérer les plages de données
    let rangeControlee = ws1.getRange(plageControleeFeuille1);
    let range1Recherche = ws1.getRange(plageRechercheFeuille1).getValues();
    let range1Critere = ws1.getRange(plageCritereFeuille1).getValues();
    let range2Recherche = ws2.getRange(plageRechercheFeuille2).getValues();
    let range2Critere = ws2.getRange(plageCritereFeuille2).getValues();
    let range3Recherche = ws3.getRange(plageRechercheFeuille3).getValues();
    let range3Critere = ws3.getRange(plageCritereFeuille3).getValues();
 
    // Fonction pour vérifier les critères
    function checkCriteria(value: string, critere: string) {
        if (critere.startsWith("<>")) {
            return value !== critere.substring(2);
        }
        return value === critere;
    }
 
    // Fonction pour rechercher les doublons avec critères
    function searchDuplicates(
        valeurRecherche: string,
        valeurCritere: string,
        rangeRecherche: string[][],
        rangeCritere: string[][],
        critere1: string,
        critere2: string
    ) {
        let count = 0;
        for (let i = 0; i < rangeRecherche.length; i++) {
            if (
                rangeRecherche[i][0] === valeurRecherche &&
                checkCriteria(rangeCritere[i][0], critere1) &&
                checkCriteria(rangeCritere[i][0], critere2)
            ) {
                count++;
            }
        }
        return count > 0;
    }
 
    // Vérifier les doublons pour chaque cellule de la plage contrôlée
    rangeControlee.getValues().forEach((row, rowIndex) => {
        row.forEach((cellValue, colIndex) => {
            let valeurRecherche = cellValue as string;
            let valeurCritere = rangeControlee.getCell(rowIndex, colIndex).getValue() as string;
 
            // Vérifier les doublons dans chaque feuille
            let doublonFeuille1 = searchDuplicates(valeurRecherche, valeurCritere, range1Recherche, range1Critere, critere1_1, critere1_2);
            let doublonFeuille2 = searchDuplicates(valeurRecherche, valeurCritere, range2Recherche, range2Critere, critere1_1, critere1_2);
            let doublonFeuille3 = searchDuplicates(valeurRecherche, valeurCritere, range3Recherche, range3Critere, critere1_1, critere1_2);
 
            // Calculer le bit final
            let bit1 = doublonFeuille1;
            let bit2 = doublonFeuille2;
            let bit3 = doublonFeuille3;
            let checkSomme = (bit1 && (bit2 || bit3)) || (bit2 && bit3);
 
            // Définir le résultat final
            let result = checkSomme && checkCriteria(valeurCritere, critere1_1) && checkCriteria(valeurCritere, critere1_2) ? 1 : 0;
 
            // Mettre à jour la cellule dans la colonne spécifiée avec le résultat
            ws1.getRange(colonneResultat + (rowIndex + 1)).setValue(result); // colonneResultat + (rowIndex + 1) pour déterminer la cellule exacte
        });
    });
}

Je ne le maitrise pas et je ne sais pas vraiment ce qu'il fait...

19/06/2024, 18h16
Jean-Philippe André

Salut,

je comprends mieux ton cheminement, merci pour ces détails.

Alors de ce que j'en vois, tu as actuellement des formules sur lesquelles tu bases tes MEFC.

je ne sais même pas si on peut faire une fonction Office Script qui soit appelable depuis une formule Excel.

Il faudrait voir si cela est possible (je ne le sais pas moi même).

Dans le cas où l'utilisation de fonction n'est pas envisageable, il faut travailler sur mettre la valeur Vrai/Faux dans les cellules, ce qui est faisable dans ce cas.

Je te propose d'y aller par étape pour
1/ créer une fonction qui affecte la valeur correctement dans une cellule
2/ la faire évoluer pour reproduire au mieux ton scénario de l'ensemble des lignes

VBA convertir en Office Script

Bonjour Jean-Philippe André,

Alors, je vais revoir mon fichier Excel entièrement...
Je vais faire une feuille principale où il y aura toute les demandes ce sera plus simple pour la gestion des doublons (ça évitera de convertir le VBA)^^
Pour commencer simple j'aimerais convertir le code VBA en OfficeScript :

Code:

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
 
Sub Worksheet_Change(ByVal Target As Range)
Select Case Macro_Actualisation_Convertion_Boss_En_Cours
 
Case False, Empty
 
    'Noter la date automatiquement lors du changement d'état
    If Not Intersect(Target, Range("AB7:AB1000")) Is Nothing Then
 
    If ActiveCell.Value = "" Then
 
            Adresse1 = ActiveCell.Offset(0, 1).Address
            Range(Adresse1).Value = ""
 
        GoTo FIN
    Else
            Adresse1 = ActiveCell.Offset(0, 1).Address
            Range(Adresse1).Value = Format(Date, "dd.mm.yyyy")
    End If
    End If
 
FIN:
 
End If
End Select

Voici le code en OScript

Code:

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
 
function main(workbook: ExcelScript.Workbook) {
    let sheet = workbook.getActiveWorksheet();
 
    // Récupère la plage modifiée
    let range = sheet.getRange("AB7:AB1000");
 
    // Itère sur chaque cellule de la plage
    for (let row = 0; row < range.getRowCount(); row++) {
        let cell = range.getCell(row, 0); // Obtient la cellule actuelle de la colonne AB
        let cellValue = cell.getValue() as string; // Déclare le type comme string pour éviter les erreurs
 
        // Vérifie si la cellule est vide
        if (cellValue === "") {
            // Si la cellule est vide, on efface la cellule à droite (colonne AC)
            let adresse1 = cell.getOffsetRange(0, 1); // Déplace de 1 colonne à droite
            adresse1.setValue("");
        } else {
            // Sinon, on met la date du jour dans la cellule à droite (colonne AC)
            let adresse1 = cell.getOffsetRange(0, 1);
            let today = new Date();
            let formattedDate = `${today.getDate().toString().padStart(2, '0')}.${(today.getMonth() + 1).toString().padStart(2, '0')}.${today.getFullYear()}`;
            adresse1.setValue(formattedDate);
        }
    }
}

Le problème est qui l'éxécute pour toute la colonne alors que je veux qu'il le fasse seulement pour la ligne qui a été modifiée