IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Excel Discussion :

VBA convertir en Office Script


Sujet :

Excel

  1. #1
    Membre régulier Avatar de Rémy.A
    Homme Profil pro
    Expert SEE ELECTRICAL EXPERT
    Inscrit en
    Juin 2017
    Messages
    114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Expert SEE ELECTRICAL EXPERT
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2017
    Messages : 114
    Points : 88
    Points
    88
    Par défaut VBA convertir en Office Script
    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

  2. #2
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Inscrit en
    Juillet 2007
    Messages
    14 638
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : Canada

    Informations professionnelles :
    Activité : Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2007
    Messages : 14 638
    Points : 34 367
    Points
    34 367
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  3. #3
    Membre régulier Avatar de Rémy.A
    Homme Profil pro
    Expert SEE ELECTRICAL EXPERT
    Inscrit en
    Juin 2017
    Messages
    114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Expert SEE ELECTRICAL EXPERT
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2017
    Messages : 114
    Points : 88
    Points
    88
    Par défaut 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 : 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
     
     
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  4. #4
    Membre régulier Avatar de Rémy.A
    Homme Profil pro
    Expert SEE ELECTRICAL EXPERT
    Inscrit en
    Juin 2017
    Messages
    114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Expert SEE ELECTRICAL EXPERT
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2017
    Messages : 114
    Points : 88
    Points
    88
    Par défaut [XL-365] VBA convertir en Office Script
    Apparemment tout le monde s'en fou....
    Ce n'est plus ce c’était de forum

  5. #5
    Membre émérite
    Homme Profil pro
    Formateur et développeur bureautique
    Inscrit en
    Mars 2007
    Messages
    1 473
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Formateur et développeur bureautique
    Secteur : Conseil

    Informations forums :
    Inscription : Mars 2007
    Messages : 1 473
    Points : 2 997
    Points
    2 997
    Par défaut
    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
    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion.

  6. #6
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Inscrit en
    Juillet 2007
    Messages
    14 638
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : Canada

    Informations professionnelles :
    Activité : Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2007
    Messages : 14 638
    Points : 34 367
    Points
    34 367
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Cycle de vie d'un bon programme :
    1/ ça fonctionne 2/ ça s'optimise 3/ ça se refactorise

    Pas de question technique par MP, je ne réponds pas

    Mes ouvrages :
    Apprendre à programmer avec Access 2016, Access 2019 et 2021

    Apprendre à programmer avec VBA Excel
    Prise en main de Dynamics 365 Business Central

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

  7. #7
    Membre régulier Avatar de Rémy.A
    Homme Profil pro
    Expert SEE ELECTRICAL EXPERT
    Inscrit en
    Juin 2017
    Messages
    114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Expert SEE ELECTRICAL EXPERT
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2017
    Messages : 114
    Points : 88
    Points
    88
    Par défaut [XL-365] VBA convertir en Office Script
    Citation Envoyé par Pierre Dumas Voir le message
    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

  8. #8
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Inscrit en
    Juillet 2007
    Messages
    14 638
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : Canada

    Informations professionnelles :
    Activité : Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2007
    Messages : 14 638
    Points : 34 367
    Points
    34 367
    Par défaut
    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.
    Cycle de vie d'un bon programme :
    1/ ça fonctionne 2/ ça s'optimise 3/ ça se refactorise

    Pas de question technique par MP, je ne réponds pas

    Mes ouvrages :
    Apprendre à programmer avec Access 2016, Access 2019 et 2021

    Apprendre à programmer avec VBA Excel
    Prise en main de Dynamics 365 Business Central

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

  9. #9
    Membre régulier Avatar de Rémy.A
    Homme Profil pro
    Expert SEE ELECTRICAL EXPERT
    Inscrit en
    Juin 2017
    Messages
    114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Expert SEE ELECTRICAL EXPERT
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2017
    Messages : 114
    Points : 88
    Points
    88
    Par défaut [XL-365] VBA convertir en Office Script
    Citation Envoyé par Jean-Philippe André Voir le message
    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

    Nom : Fonction doublons MEC F 2024.JPG
Affichages : 74
Taille : 42,6 Ko

    Nom : Fonction doublons F 2023.JPG
Affichages : 72
Taille : 69,0 Ko

    Nom : Fonction doublons F 2024.JPG
Affichages : 71
Taille : 82,8 Ko

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

    Nom : Fonction doublons F 2023 dans cellule.JPG
Affichages : 72
Taille : 150,1 Ko

    J'avais commencé avec chat GPT et il m'a fourni ce 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
     
    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...

  10. #10
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Inscrit en
    Juillet 2007
    Messages
    14 638
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 40
    Localisation : Canada

    Informations professionnelles :
    Activité : Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2007
    Messages : 14 638
    Points : 34 367
    Points
    34 367
    Par défaut
    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
    Cycle de vie d'un bon programme :
    1/ ça fonctionne 2/ ça s'optimise 3/ ça se refactorise

    Pas de question technique par MP, je ne réponds pas

    Mes ouvrages :
    Apprendre à programmer avec Access 2016, Access 2019 et 2021

    Apprendre à programmer avec VBA Excel
    Prise en main de Dynamics 365 Business Central

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

Discussions similaires

  1. [VBA] Convertir première ligne en ligne de champs
    Par NiKoTiNe dans le forum VBA Access
    Réponses: 5
    Dernier message: 22/05/2007, 15h31
  2. [VBA] Convertir un état en PDF et l'envoyer par mail
    Par snoopy69 dans le forum VBA Access
    Réponses: 3
    Dernier message: 04/12/2006, 10h56
  3. [vba] convertir une string en date
    Par megapacman dans le forum Access
    Réponses: 1
    Dernier message: 11/09/2006, 15h46
  4. Réponses: 6
    Dernier message: 14/06/2006, 15h49
  5. [VBA-E]Lancer un script perl
    Par mirascheat dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 12/10/2005, 19h39

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo