Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 5f9bcd3e29c4da9e…

MALICIOUS

Office (OOXML)

126.3 KB Created: 2021-02-17 08:47:33 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-11-20
MD5: 45209a5804080b11252879b61a957fd1 SHA-1: 8ce57d01aac8e8afe7fbfa1e48a1579ab41254f2 SHA-256: 5f9bcd3e29c4da9e757f85d08e41202c06daacf356be45b36018832f41059b49
290 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1059.003 Windows Command Shell T1071.001 Web Protocols T1105 Ingress Tool Transfer

The sample contains VBA macros that leverage WScript.Shell to execute a command-line utility. This utility is used to append data from the spreadsheet to a network file share at \\domainemaif\DFSMAIF\Echanges\CDC_ATOS_GPA_IARD\70 - Divers\statistiques\stats_bordereau.txt. The macros also reference several URLs, suggesting potential download or C2 communication capabilities.

Heuristics 8

  • VBA project inside OOXML medium 6 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
            varProc = Shell("cmd /C echo """ & Sheets("bordereau").Cells(4, 7).Text & "  " & Sheets("bordereau").Cells(12, 6).Text & "  " & Sheets("bordereau").Cells(ligne, 1).Text & "  " & Sheets("bordereau").Cells(ligne, 2).Text & "  " & Sheets("bordereau").Cells(ligne, 3).Text & "  " & Sheets("bordereau").Cells(ligne, 4).Text & "  " & """ 1>>""" & fichier & """", 0)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
    CreateObject("WScript.Shell").Popup "Traitement terminé", 1, "Comparaison", 4096
  • VBA downloads and writes a file to disk critical OLE_VBA_HTTP_DROP_EXEC
    VBA reads an HTTP response body and writes it to disk (ADODB.Stream SaveToFile). Combined with the auto-exec/Shell paths this is a download-drop dropper even when the COM ProgIDs are built dynamically to evade keyword scanning.
    Matched line in script
       oStream.Write WinHttpReq.responseBody
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
            varProc = Shell("cmd /C echo """ & Sheets("bordereau").Cells(4, 7).Text & "  " & Sheets("bordereau").Cells(12, 6).Text & "  " & Sheets("bordereau").Cells(ligne, 1).Text & "  " & Sheets("bordereau").Cells(ligne, 2).Text & "  " & Sheets("bordereau").Cells(ligne, 3).Text & "  " & Sheets("bordereau").Cells(ligne, 4).Text & "  " & """ 1>>""" & fichier & """", 0)
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
       If Len(Dir(Environ("TEMP") & "/fichierkub.csv")) > 0 Then Kill Environ("TEMP") & "/fichierkub.csv"
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://api.trail-prod.maif.local:9080//v1/kubernetes/deployment-events/csv?onlyLastDeployments=true&onlyLastDeploymentsDate= Referenced by macro
    • http://api.trail-prod.maif.local:9080//v1/inventaires-rancher-view/csv?onlyLastInventairesRancher=true&onlyLastInventairesRancherDate=Referenced by macro
    • http://api.trail-prod.maif.local:9080//v1/deploiements-standards-view/csv?onlyLastDeploiements=true&onlyLastDeploiementsDate=Referenced by macro

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 64985 bytes
SHA-256: f19cd9eb3290b03ae6f826efd537d86866a1c1b5eed924575a5c7c111fe91ceb
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic

'''''''''''''' KPI
If ActiveSheet.Name = "bordereau" Then
    For ligne = 13 To 100000
        If Sheets("bordereau").Cells(ligne, 1).Text = "" Then Exit For
        fichier = "\\domainemaif\DFSMAIF\Echanges\CDC_ATOS_GPA_IARD\70 - Divers\statistiques\stats_bordereau.txt"
        varProc = Shell("cmd /C echo """ & Sheets("bordereau").Cells(4, 7).Text & "  " & Sheets("bordereau").Cells(12, 6).Text & "  " & Sheets("bordereau").Cells(ligne, 1).Text & "  " & Sheets("bordereau").Cells(ligne, 2).Text & "  " & Sheets("bordereau").Cells(ligne, 3).Text & "  " & Sheets("bordereau").Cells(ligne, 4).Text & "  " & """ 1>>""" & fichier & """", 0)
    Next
End If

'''''''''''''' purge des onglets
Sheets("temp").Range("A:B").ClearContents
'copie temporaire dans temp
For ar = 2 To 10000
    If Sheets("travail").Cells(1, ar).Value = "" Then Exit For
    Sheets("temp").Cells(1, ar).Value = Sheets("travail").Cells(1, ar).Value
    Sheets("temp").Cells(2, ar).Value = Sheets("travail").Cells(2, ar).Value
Next
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 7) = "Travail" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 11) = "donneestemp" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 7) = "donnees" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "kub" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "eod" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "ran" Then
        feuille.Delete
        GoTo next_i
    End If
next_i:
Next feuille
Sheets.Add Before:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "Travail"
Next
'recopie dans travail
For ar = 2 To 10000
    If Sheets("temp").Cells(1, ar).Value = "" Then Exit For
    Sheets("travail").Cells(1, ar).Value = Sheets("temp").Cells(1, ar).Value
    Sheets("travail").Cells(2, ar).Value = Sheets("temp").Cells(2, ar).Value
    Sheets("travail").Cells(2, ar).NumberFormat = "m/d/yyyy h:mm"
Next
Sheets("travail").Cells(1, 1).Value = "Ctrl + q"
Sheets("travail").Columns("A:A").ColumnWidth = 129.71
Sheets("travail").Columns("B:G").ColumnWidth = 16.43
For Each feuille In Sheets
    If Left(feuille.Name, 4) = "temp" Then feuille.Delete
Next
'recréation des onglets
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "donneestemp"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "donnees"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "kub"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "eod"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "ran"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "temp"
Next
'déplacement des onglets
For Each feuille In Sheets
    If Left(feuille.Name, 7) = "Travail" Then
        Sheets("Consignes").Move After:=feuille
        Sheets("Spécificités").Move After:=feuille
        Sheets("bordereau").Move After:=feuille
    End If
Next

Application.DisplayStatusBar = False
Application.ScreenUpdating = True
Sheets("Travail").Select
Range("A1").Select
End Sub



Attribute VB_Name = "Feuil8"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Module2"
Option Compare Text

Sub bordereau()

'_______________________________________bordereau

For t = 2 To 1000
    maxcompare = t - 1
    If InStr(1, Sheets("travail").Cells(1, t).Text, "-") > 0 Then trouver = 1
    If Sheets("travail").Cells(1, t).Value = "" Then Exit For
Next
If trouver <> 1 Then Exit Sub

Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "Bordereau"

' =========== génération du bordereau
For Each shee In ActiveWorkbook.Sheets
 If shee.Name = "bordereau" Then shee.Delete
Next

Sheets("modele").Copy Before:=Sheets(5)
ActiveWindow.ActiveSheet.Name = "bordereau"

ligneactu = 13
For ligne = 3 To 100000
    If Sheets("travail").Cells(ligne, 1).Text = "" Then Exit For
    If Sheets("travail").Cells(ligne, maxcompare).Text <> "" Then
        premi = Replace(Split(Sheets("travail").Cells(1, maxcompare).Text, "-")(1), ":", "")
        deuxi = Replace(Split(Sheets("travail").Cells(1, maxcompare).Text, "-")(0), ":", "")

        testcompare = 0
        'test si le docker a changé (dans ce cas, relivrer le helm)
        If Len(Sheets("travail").Range("A" & ligne - 1).Text) > 5 And Len(Sheets("travail").Range("A" & ligne).Text) > 3 Then
            If Right(Sheets("travail").Range("A" & ligne - 1).Text, 6) = "docker" And Right(Sheets("travail").Range("A" & ligne).Text, 4) = "helm" Then
                If Left(Sheets("travail").Range("A" & ligne - 1).Text, Len(Sheets("travail").Range("A" & ligne - 1).Text) - 6) = Left(Sheets("travail").Range("A" & ligne).Text, Len(Sheets("travail").Range("A" & ligne).Text) - 4) Then
                    If Sheets("travail").Range(premi & ligne - 1).Text <> Sheets("travail").Cells(ligne - 1, maxcompare).Text Then
                        testcompare = 1
                        Sheets("bordereau").Cells(ligneactu, 8).Value = "Le docker évolue : " & Sheets("travail").Range(premi & ligne - 1).Text & " -> " & Sheets("travail").Cells(ligne - 1, maxcompare).Text
                    End If
                End If
            End If
        End If
        purgetrav = 0
        's'il y a des différences
        If (Sheets("travail").Range("B" & ligne).Text <> Sheets("travail").Range("C" & ligne).Text And Sheets("travail").Range("C" & ligne).Text <> Sheets("travail").Range("D" & ligne).Text) Or Sheets("travail").Range(premi & ligne).Text <> Sheets("travail").Cells(ligne, maxcompare).Text Or testcompare = 1 Then
            Call couleur(ligne)
            eclateligne = Split(Sheets("travail").Cells(ligne, 1).Value, "___")
            Sheets("bordereau").Cells(4, 7).Value = Sheets("travail").Range(Split(Sheets("travail").Cells(1, maxcompare).Text, "-")(1) & "1").Value
            Sheets("bordereau").Cells(11, 4).Value = Sheets("travail").Range("B1").Text
            Sheets("bordereau").Cells(12, 4).Value = Sheets("travail").Range("B2").Value
            Sheets("bordereau").Cells(11, 5).Value = Sheets("travail").Range("C1").Text
            Sheets("bordereau").Cells(12, 5).Value = Sheets("travail").Range("C2").Value
            Sheets("bordereau").Cells(ligneactu, 1).Value = eclateligne(0)
            Sheets("bordereau").Cells(ligneactu, 2).Value = eclateligne(1)
            Sheets("bordereau").Cells(ligneactu, 3).Value = eclateligne(2)
            Sheets("bordereau").Cells(ligneactu, 4).Value = "'" & Sheets("travail").Range("B" & ligne).Text
            Sheets("bordereau").Cells(ligneactu, 4).Font.ColorIndex = Sheets("travail").Range("B" & ligne).Font.ColorIndex
            Sheets("bordereau").Cells(ligneactu, 5).Value = "'" & Sheets("travail").Range("C" & ligne).Text
            Sheets("bordereau").Cells(ligneactu, 5).Font.ColorIndex = Sheets("travail").Range("C" & ligne).Font.ColorIndex
            Sheets("bordereau").Cells(ligneactu, 6).Value = "'" & Sheets("travail").Range(premi & ligne).Text
            Sheets("bordereau").Cells(ligneactu, 6).Font.ColorIndex = Sheets("travail").Range(premi & ligne).Font.ColorIndex
            If Sheets("bordereau").Cells(ligneactu, 6).Text = "#N/A" Then Sheets("bordereau").Cells(ligneactu, 6).Value = ""
            Sheets("bordereau").Cells(ligneactu, 7).Value = "'" & Sheets("travail").Cells(ligne, maxcompare).Text
            Sheets("bordereau").Cells(ligneactu, 7).Font.ColorIndex = Sheets("travail").Cells(ligne, maxcompare).Font.ColorIndex
            If Sheets("bordereau").Cells(ligneactu, 7).Text = "#N/A" Then Sheets("bordereau").Cells(ligneactu, 7).Value = ""
            If Sheets("bordereau").Cells(ligneactu, 7).Text = "DELETED" Then Sheets("bordereau").Cells(ligneactu, 8).Value = ""
            Sheets("bordereau").Cells(ligneactu, 9).Value = ""
            Sheets("bordereau").Cells(ligneactu, 10).Value = ""
            'si les 3 sont differents
            If maxcompare = 6 And Sheets("travail").Range("B" & ligne).Text <> Sheets("travail").Range("C" & ligne).Text And Sheets("travail").Range("C" & ligne).Text <> Sheets("travail").Range("D" & ligne).Text Then
                    Sheets("bordereau").Cells(ligneactu, 8).Value = "Action attendue - " & Sheets("bordereau").Cells(ligneactu, 8).Text
                    purgetrav = 1
            End If
            ligneactu = ligneactu + 1
            Sheets("travail").Rows(ligne & ":" & ligne).RowHeight = Sheets("travail").Rows(3 & ":" & 3).RowHeight
            Application.StatusBar = "Bordereau nb livrables :" & ligneactu
        End If
        If Sheets("travail").Range(premi & ligne).Text <> Sheets("travail").Cells(ligne, maxcompare).Text Or purgetrav = 1 Then
            Sheets("travail").Rows(ligne & ":" & ligne).RowHeight = 0
            
        End If
    End If
Next

'____________________________ Spécificités
ancienclass = ThisWorkbook.Name
For ligne = 13 To ligneactu
    lignemax = ligne
    Application.StatusBar = "Bordereau specificites :" & ligne & "/" & ligneactu
    'specificités packaging
    For parclign = 2 To 100000
        If Sheets("Spécificités").Cells(parclign, 1).Value = "" Then Exit For
        If LCase(Sheets("bordereau").Cells(ligne, 1).Value) = LCase(Sheets("Spécificités").Cells(parclign, 1).Value) Then
            'premier champs
            onatrouveprem = 0
            If LCase(Sheets("bordereau").Cells(ligne, 2).Value) = LCase(Sheets("Spécificités").Cells(parclign, 2).Value) Then
                onatrouveprem = 1
            End If
            If LCase(Sheets("bordereau").Cells(ligne, 2).Value) = "" Then
                onatrouveprem = 1
            End If
            If InStr(1, Sheets("Spécificités").Cells(parclign, 2).Value, "*") > 0 Then
                avantetoile = Split(Sheets("Spécificités").Cells(parclign, 2).Value, "*")(0)
                apresetoile = Split(Sheets("Spécificités").Cells(parclign, 2).Value, "*")(1)
                If Left(Sheets("bordereau").Cells(ligne, 2).Text, Len(avantetoile)) = avantetoile And Right(Sheets("bordereau").Cells(ligne, 2).Text, Len(apresetoile)) = apresetoile Then
                    onatrouveprem = 1
                End If
            End If

            'deuxième champs
            onatrouve = 0
            If LCase(Sheets("bordereau").Cells(ligne, 3).Value) = LCase(Sheets("Spécificités").Cells(parclign, 3).Value) Then
                onatrouve = 1
            End If
            If LCase(Sheets("bordereau").Cells(ligne, 3).Value) = "" Then
                onatrouve = 1
            End If
            If InStr(1, Sheets("Spécificités").Cells(parclign, 3).Value, "*") > 0 Then
                avantetoile = Split(Sheets("Spécificités").Cells(parclign, 3).Value, "*")(0)
                apresetoile = Split(Sheets("Spécificités").Cells(parclign, 3).Value, "*")(1)
                If Left(Sheets("bordereau").Cells(ligne, 3).Text, Len(avantetoile)) = avantetoile And Right(Sheets("bordereau").Cells(ligne, 3).Text, Len(apresetoile)) = apresetoile Then
                    onatrouve = 1
                End If
            End If
            trouver = 0
            If onatrouveprem = 1 And onatrouve = 1 Then
                For lao = 6 To 100000
                    If Sheets("Spécificités").Cells(1, lao).Value = "" Then Exit For
                    If LCase(Sheets("Spécificités").Cells(parclign, lao).Text) = "x" And LCase(Sheets("bordereau").Cells(4, 7).Text) = LCase(Sheets("Spécificités").Cells(1, lao).Text) Then
                        trouver = 1
                        Sheets("bordereau").Rows(ligne & ":" & ligne).RowHeight = Sheets("bordereau").Rows("1:1").RowHeight
                        Sheets("bordereau").Cells(ligne, 3).Interior.ColorIndex = xlNone
                        Select Case Sheets("Spécificités").Cells(parclign, 4).Value
                            Case "affichage"
                                Sheets("bordereau").Cells(ligne, 3).Interior.Color = Sheets("Spécificités").Cells(parclign, 5).Interior.Color
                            Case "suppression"
                                Sheets("bordereau").Rows(ligne & ":" & ligne).RowHeight = 0
                        End Select
                        If Sheets("Spécificités").Cells(parclign, 5).Value = "Déployable via CD" Then
                            Sheets("bordereau").Cells(ligne, 1).Value = "Cloudbees"
                        End If
                        If Sheets("Spécificités").Cells(parclign, 5).Value <> "" Then Sheets("bordereau").Cells(ligne, 9).Value = Sheets("Spécificités").Cells(parclign, 5).Text
                    End If
                Next
            End If
        End If
    Next
Next

'suppression des lignes
For ligne = 13 To lignemax
    If Sheets("bordereau").Cells(ligne, 1).Value = "" Then Exit For
    If Sheets("bordereau").Rows(ligne & ":" & ligne).RowHeight = 0 Or Right(Sheets("bordereau").Cells(ligne, 3).Value, 9) = "   docker" Then
        Sheets("bordereau").Cells(ligne, 1).EntireRow.ClearContents
        Sheets("bordereau").Rows(ligne & ":" & ligne).RowHeight = Sheets("bordereau").Rows("1:1").RowHeight
        Sheets("bordereau").Cells(ligne, 3).Interior.ColorIndex = xlNone
    End If
Next

ActiveWorkbook.Worksheets("bordereau").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("bordereau").Sort.SortFields.Add Key:=Sheets("bordereau").Cells(13, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("bordereau").Sort
    .SetRange Sheets("bordereau").Range(Cells(13, 1), Cells(lignemax, 100))
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'renommage en supprimant la notion de docker/helm, et renommage des livrables eode
For ligne = 13 To lignemax
    If Sheets("bordereau").Cells(ligne, 1).Value = "" Then Exit For
    If Right(Sheets("bordereau").Cells(ligne, 3).Text, 7) = "   helm" Then
        Sheets("bordereau").Cells(ligne, 3).Value = Split(Sheets("bordereau").Cells(ligne, 3).Text, "   ")(0)
    End If
    If Sheets("bordereau").Cells(ligne, 1).Text = "eode" And InStr(1, Sheets("bordereau").Cells(ligne, 3).Text, ":") > 0 Then
        nomlivr = Split(Sheets("bordereau").Cells(ligne, 3).Text, ":")(1)
        Sheets("bordereau").Cells(ligne, 3).Value = nomlivr
    End If
Next

'alimenter les GAV et GAP
For ligne = 13 To lignemax
    If Sheets("bordereau").Cells(ligne, 1).Value = "" Then Exit For
    If Sheets("bordereau").Cells(ligne, 1).Value = "eode" Then
        Sheets("bordereau").Cells(ligne, 10).FormulaLocal = "=concatener(""" & ";" & Sheets("bordereau").Cells(ligne, 3).Value & ":" & """;G" & ligne & ")"
        Sheets("bordereau").Cells(ligne, 11).FormulaLocal = "=concatener(""" & ";;" & Sheets("bordereau").Cells(ligne, 2).Value & ";;" & Sheets("bordereau").Cells(ligne, 3).Value & ";;;;"";G" & ligne & ";""-->"";F" & ligne & ";""???"")"
    End If
Next

'création du CSV pour cloudbees
contenucloud = "applicationProjectName;applicationName;componentName;componentVersion"
trouvecloud = 0
For ligne = 13 To 10000
    If Sheets("bordereau").Cells(ligne, 1).Value = "" Then Exit For
    If Sheets("bordereau").Cells(ligne, 1).Value = "Cloudbees" And Sheets("bordereau").Cells(ligne, 7).Value <> "DELETED" Then
        trouvecloud = 1
        contenucloud = contenucloud & Chr(10) & Sheets("bordereau").Cells(ligne, 2).Value & ";" & Sheets("bordereau").Cells(ligne, 2).Value & ";" & Sheets("bordereau").Cells(ligne, 3).Value & ";" & Sheets("bordereau").Cells(ligne, 7).Value
    End If
Next
If trouvecloud = 1 Then
    Sheets("bordereau").Cells(9, 9).Value = contenucloud
    Sheets("bordereau").Cells(9, 8).Value = "Cloudbees CSV"
    Sheets("bordereau").Cells(9, 8).Interior.ColorIndex = 24
Else
    Sheets("bordereau").Cells(9, 9).Value = ""
End If

Cells.EntireColumn.AutoFit
Sheets("bordereau").Rows("9:9").RowHeight = Sheets("bordereau").Rows("1:1").RowHeight

'mémorisation des paramètres de lancement
For ar = 2 To 6
    If Sheets("travail").Cells(1, ar).Value = "" Then Exit For
    Sheets("bordereau").Cells(9, ar - 1).Value = Sheets("travail").Cells(1, ar).Value
    Sheets("bordereau").Cells(10, ar - 1).Value = Sheets("travail").Cells(2, ar).Value
    If ar < 5 Then
        Sheets("bordereau").Cells(11, ar + 2).Value = Sheets("travail").Cells(1, ar).Value
        Sheets("bordereau").Cells(12, ar + 2).Value = Sheets("travail").Cells(2, ar).Value
    End If
Next

End Sub

Attribute VB_Name = "Feuil5"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Feuil4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Feuil2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Feuil6"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Module3"
Option Compare Text

Sub Macro3()
Attribute Macro3.VB_ProcData.VB_Invoke_Func = "q\n14"
'
' Macro3 Macro
'
' Touche de raccourci du clavier: Ctrl+q
'
Dim c As Range
Dim compcontA As String
Dim compcontB As String

affichage = Now()

answer = MsgBox("Voulez-vous aussi inclure EODE ?", vbQuestion + vbYesNo + vbDefaultButton2, "Eode")
If answer = vbYes Then
    courtcircuit = 1
End If

varProc = Shell("wmic process where name=""excel.exe"" CALL setpriority 128", 0)

Sheets("travail").Select
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic

'''''''''''''' purge des onglets
Sheets("temp").Range("A:B").ClearContents
'copie temporaire dans temp
For ar = 2 To 10000
    If Sheets("travail").Cells(1, ar).Value = "" Then Exit For
    Sheets("temp").Cells(1, ar).Value = Sheets("travail").Cells(1, ar).Value
    Sheets("temp").Cells(2, ar).Value = Sheets("travail").Cells(2, ar).Value
Next
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 7) = "Travail" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 11) = "donneestemp" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 7) = "donnees" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "kub" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "eod" Then
        feuille.Delete
        GoTo next_i
    End If
    If Left(feuille.Name, 3) = "ran" Then
        feuille.Delete
        GoTo next_i
    End If
next_i:
Next feuille
Sheets.Add Before:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "Travail"
Next
'recopie dans travail
For ar = 2 To 10000
    If Sheets("temp").Cells(1, ar).Value = "" Then Exit For
    Sheets("travail").Cells(1, ar).Value = Sheets("temp").Cells(1, ar).Value
    Sheets("travail").Cells(2, ar).Value = Sheets("temp").Cells(2, ar).Value
    Sheets("travail").Cells(2, ar).NumberFormat = "m/d/yyyy h:mm"
Next
Sheets("travail").Cells(1, 1).Value = "Ctrl + q"
Sheets("travail").Columns("A:A").ColumnWidth = 129.71
Sheets("travail").Columns("B:G").ColumnWidth = 16.43
For Each feuille In Sheets
    If Left(feuille.Name, 4) = "temp" Then feuille.Delete
Next
'recréation des onglets
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "donneestemp"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "donnees"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "kub"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "eod"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "ran"
Next
Sheets.Add After:=ActiveSheet
For Each feuille In Sheets
    If InStr(1, feuille.Name, "Feuil") > 0 Then feuille.Name = "temp"
Next
'déplacement des onglets
For Each feuille In Sheets
    If Left(feuille.Name, 7) = "Travail" Then
        Sheets("Consignes").Move After:=feuille
        Sheets("Spécificités").Move After:=feuille
        Sheets("bordereau").Move After:=feuille
    End If
Next
'suppression des connections
For Each cn In ActiveWorkbook.Connections
       cn.Delete
Next
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")

debutecrire = 1
operation = 0
'pour toutes les colonnes
For t = 2 To 1000
    maxcompare = t - 1
    If Sheets("travail").Cells(1, t).Value = "" Then Exit For
Next
For lacol = 2 To 1000
    maxlacol = lacol - 1
    If Sheets("travail").Cells(1, lacol) = "" Or InStr(1, Sheets("travail").Cells(1, lacol).Value, "-") > 0 Or InStr(1, Sheets("travail").Cells(1, lacol).Value, "+") > 0 Then
        If InStr(1, Sheets("travail").Cells(1, lacol).Value, "-") > 0 Or InStr(1, Sheets("travail").Cells(1, lacol).Value, "+") Then operation = lacol
        Exit For
    End If
   listeenv = ""
   ' recherche la correspondance des environnements
   listeenvkub = ""
   listeenveod = ""
   listeenvran = ""
   For y = 1 To 1000000
        If Sheets("environnements_ran").Cells(y, 1).Value = "" Then Exit For
        If Sheets("environnements_ran").Cells(y, 2).Value = Sheets("travail").Cells(1, lacol).Value Then
            listeenvran = listeenvran & "&libelleStack=" & Sheets("environnements_ran").Cells(y, 1).Value
        End If
    Next
    listeenvkub = listeenvkub & "&environnement=%22" & Sheets("travail").Cells(1, lacol).Value & "%22"
    listeenveod = "&libelleEnvironnement=" & Sheets("travail").Cells(1, lacol).Value

    datextract = Format(Sheets("travail").Cells(2, lacol).Value, "yyyy-mm-dd")
    heureextract = Split(Format(Sheets("travail").Cells(2, lacol).Value, "hh:mm"), ":")
    Sheets("temp").Cells(1, 1).FormulaLocal = "=nbval(travail!A:A)"
   
   Sheets("donnees").Cells.Clear
   Sheets("donnees").Select
   '================================================================================== API trail kubernetes
   Application.StatusBar = "Environnements kub :" & Sheets("travail").Cells(1, lacol).Value & " - " & Sheets("travail").Cells(2, lacol).Value
   If Len(Dir(Environ("TEMP") & "/fichierkub.csv")) > 0 Then Kill Environ("TEMP") & "/fichierkub.csv"
   myurl = "http://api.trail-prod.maif.local:9080//v1/kubernetes/deployment-events/csv?onlyLastDeployments=true&onlyLastDeploymentsDate=" & datextract & "T" & heureextract(0) & "%3A" & heureextract(1) & "%3A00Z&page=1&sizePerPage=10" & listeenvkub
   Sheets("temp").Cells(5, 1).Value = myurl
   WinHttpReq.Open "GET", myurl, False, "username", "password"
   WinHttpReq.send
   Set oStream = CreateObject("ADODB.Stream")
   oStream.Open
   oStream.Type = 1
   oStream.Write WinHttpReq.responseBody
   oStream.SaveToFile Environ("TEMP") & "/fichierkub.csv", 2
   oStream.Close
   IndexFichier = FreeFile()
   Sheets("kub").Cells.Clear
   With Sheets("kub").QueryTables.Add(Connection:= _
       "TEXT;" & Environ("TEMP") & "/fichierkub.csv", Destination:= _
       Sheets("kub").Range("$A$1"))
       .Name = "fichierkub"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 850
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
   End With
   nomsheetkub = "kub"
   
   '_____________________________________________________________ extraction des données kubernetes - docker
   Sheets(nomsheetkub).Select
   For t = 2 To 1000000
       enviunit = t - 1
       If Sheets("kub").Cells(t, 1).Value = "" Then Exit For
   Next
   Range("A2").FormulaLocal = "=SI(L2=""DELETED"";""DELETED"";G2)"
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.FillDown
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.Copy
   Range("G2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("A2").FormulaLocal = "=SI(L2=""DELETED"";""DELETED"";I2)"
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.FillDown
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.Copy
   Range("I2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("A2").FormulaLocal = "=CONCATENER(""kubernetes___"";C2;""___"";F2;""   docker"")"
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.FillDown
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.Copy
   Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("M2").FormulaLocal = "=CONCATENER(""kubernetes___"";C2;""___"";F2;""   helm"")"
   Range(Cells(2, 13), Cells(enviunit, 13)).Select
   Selection.FillDown
   Range(Cells(2, 13), Cells(enviunit, 13)).Select
   Selection.Copy
   Range("M2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("D2").FormulaLocal = "=CONCATENER(""" & Sheets("travail").Cells(1, lacol).Value & "___"";A2)"
   Range(Cells(2, 4), Cells(enviunit, 4)).Select
   Selection.FillDown
   Range(Cells(2, 4), Cells(enviunit, 4)).Select
   Selection.Copy
   Range("D2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("N2").FormulaLocal = "=CONCATENER(""" & Sheets("travail").Cells(1, lacol).Value & "___"";M2)"
   Range(Cells(2, 14), Cells(enviunit, 14)).Select
   Selection.FillDown
   Range(Cells(2, 14), Cells(enviunit, 14)).Select
   Selection.Copy
   Range("N2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   ActiveWorkbook.Worksheets(nomsheetkub).Sort.SortFields.Clear
   ActiveWorkbook.Worksheets(nomsheetkub).Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets(nomsheetkub).Sort
       .SetRange Range("A2:N" & enviunit)
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
   For t = 1 To 1000000
       enviunit = t - 1
       If Sheets("kub").Cells(t, 1).Value = "" Then Exit For
   Next
   Columns("C:C").ClearContents
    Columns("I:I").Copy
    Range("B1").Select
    ActiveSheet.Paste
    Range("A2:D" & enviunit).Select
   Selection.Copy
   For t = 1 To 1000000
       enviunit = t - 1
       If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
   Next
   Sheets("donnees").Select
   Sheets("donnees").Range("A" & enviunit + 1).Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   '_____________________________________________________________ extraction des données kubernetes - charts
   Sheets(nomsheetkub).Select
    Columns("M:M").Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("N:N").Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("G:G").Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
    For t = 2 To 1000000
       enviunit = t - 1
       If Sheets("kub").Cells(t, 1).Value = "" Then Exit For
   Next
    Range("A2:D" & enviunit).Select
   Selection.Copy
   For t = 1 To 1000000
       enviunit = t - 1
       If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
   Next
   Sheets("donnees").Select
   Sheets("donnees").Range("A" & enviunit + 1).Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   
   '================================================================================== API trail rancher
   Application.StatusBar = "Environnements ran :" & Sheets("travail").Cells(1, lacol).Value & " - " & Sheets("travail").Cells(2, lacol).Value
   If Len(Dir(Environ("TEMP") & "/fichierran.csv")) > 0 Then Kill Environ("TEMP") & "/fichierran.csv"
   myurl = "http://api.trail-prod.maif.local:9080//v1/inventaires-rancher-view/csv?onlyLastInventairesRancher=true&onlyLastInventairesRancherDate=" & datextract & "T" & heureextract(0) & "%3A" & heureextract(1) & "%3A00Z&page=1&sizePerPage=10" & listeenvran
   Sheets("temp").Cells(5, 1).Value = myurl
   WinHttpReq.Open "GET", myurl, False, "username", "password"
   WinHttpReq.send
   Set oStream = CreateObject("ADODB.Stream")
   oStream.Open
   oStream.Type = 1
   oStream.Write WinHttpReq.responseBody
   oStream.SaveToFile Environ("TEMP") & "/fichierran.csv", 2
   oStream.Close
   IndexFichier = FreeFile()
   Sheets("ran").Cells.Clear
   With Sheets("ran").QueryTables.Add(Connection:= _
       "TEXT;" & Environ("TEMP") & "/fichierran.csv", Destination:= _
       Sheets("ran").Range("$A$1"))
       .Name = "fichierran"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .TextFilePromptOnRefresh = False
       .TextFilePlatform = 850
       .TextFileStartRow = 1
       .TextFileParseType = xlDelimited
       .TextFileTextQualifier = xlTextQualifierDoubleQuote
       .TextFileConsecutiveDelimiter = False
       .TextFileTabDelimiter = False
       .TextFileSemicolonDelimiter = True
       .TextFileCommaDelimiter = False
       .TextFileSpaceDelimiter = False
       .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
       .TextFileTrailingMinusNumbers = True
       .Refresh BackgroundQuery:=False
   End With
   nomsheetran = "ran"

   '_____________________________________________________________ extraction des données rancher
   Sheets(nomsheetran).Select
   For t = 2 To 1000000
       enviunit = t - 1
       If Sheets("ran").Cells(t, 1).Value = "" Then Exit For
   Next
   'Range("A2").FormulaLocal = "=CONCATENER(G2;""     "";E2)"
   'Range(Cells(2, 1), Cells(enviunit, 1)).Select
   'Selection.FillDown
   'Range(Cells(2, 1), Cells(enviunit, 1)).Select
   'Selection.Copy
   'Range("G2").Select
   'Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Range("A2").FormulaLocal = "=CONCATENER(""rancher___"";SI(ESTERR(CHERCHE(""" & Sheets("travail").Cells(1, lacol).Value & """;C2));C2;GAUCHE(C2;CHERCHE(""" & Sheets("travail").Cells(1, lacol).Value & """;C2)-1));""___"";D2;"" : "";F2)"
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.FillDown
   Range(Cells(2, 1), Cells(enviunit, 1)).Select
   Selection.Copy
   Range("A2").Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Columns("B:F").Select
   Selection.Delete Shift:=xlToLeft
   Range("D2").FormulaLocal = "=CONCATENER(""" & Sheets("travail").Cells(1, lacol).Value & "___"";A2)"
   Range(Cells(2, 4), Cells(enviunit, 4)).Select
   Selection.FillDown
   Range("A2:D" & enviunit).Select
   Selection.Copy
   For t = 1 To 1000000
       enviunit = t - 1
       If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
   Next
   Sheets("donnees").Select
   Sheets("donnees").Range("A" & enviunit + 1).Select
   Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    If courtcircuit = 1 Then
       '================================================================================== API trail eode
       Application.StatusBar = "Environnements eod :" & Sheets("travail").Cells(1, lacol).Value & " - " & Sheets("travail").Cells(2, lacol).Value
       If Len(Dir(Environ("TEMP") & "/fichiereod.csv")) > 0 Then Kill Environ("TEMP") & "/fichiereod.csv"
       myurl = "http://api.trail-prod.maif.local:9080//v1/deploiements-standards-view/csv?onlyLastDeploiements=true&onlyLastDeploiementsDate=" & datextract & "T" & heureextract(0) & "%3A" & heureextract(1) & "%3A00Z&page=1&sizePerPage=10" & listeenveod & "&withId=false"
       Sheets("temp").Cells(5, 1).Value = myurl
       WinHttpReq.Open "GET", myurl, False, "username", "password"
       WinHttpReq.send
       Set oStream = CreateObject("ADODB.Stream")
       oStream.Open
       oStream.Type = 1
       oStream.Write WinHttpReq.responseBody
       oStream.SaveToFile Environ("TEMP") & "/fichiereod.csv", 2
       oStream.Close
       IndexFichier = FreeFile()
       Sheets("eod").Cells.Clear
       With Sheets("eod").QueryTables.Add(Connection:= _
           "TEXT;" & Environ("TEMP") & "/fichiereod.csv", Destination:= _
           Sheets("eod").Range("$A$1"))
           .Name = "fichierran"
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = False
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .TextFilePromptOnRefresh = False
           .TextFilePlatform = 850
           .TextFileStartRow = 1
           .TextFileParseType = xlDelimited
           .TextFileTextQualifier = xlTextQualifierDoubleQuote
           .TextFileConsecutiveDelimiter = False
           .TextFileTabDelimiter = False
           .TextFileSemicolonDelimiter = True
           .TextFileCommaDelimiter = False
           .TextFileSpaceDelimiter = False
           .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
           .TextFileTrailingMinusNumbers = True
           .Refresh BackgroundQuery:=False
       End With
       nomsheeteod = "eod"

    '_____________________________________________________________ extraction des données eode
       Sheets(nomsheeteod).Select
       For t = 2 To 1000000
           enviunit = t - 1
           If Sheets("eod").Cells(t, 1).Value = "" Then Exit For
       Next
       Range("A2").FormulaLocal = "=CONCATENER(""eode___"";J2;""___"";B2)"
       Range(Cells(2, 1), Cells(enviunit, 1)).Select
       Selection.FillDown
       Range(Cells(2, 1), Cells(enviunit, 1)).Select
       Selection.Copy
       Range("A2").Select
       Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
       Columns("B:B").Select
       Selection.Delete Shift:=xlToLeft
       Columns("C:C").Select
       Selection.Delete Shift:=xlToLeft
       Range("D2").FormulaLocal = "=CONCATENER(""" & Sheets("travail").Cells(1, lacol).Value & "___"";A2)"
       Range(Cells(2, 4), Cells(enviunit, 4)).Select
       Selection.FillDown
       Range("A2:D" & enviunit).Select
       Selection.Copy
       For t = 1 To 1000000
           enviunit = t - 1
           If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
       Next
       Sheets("donnees").Select
       Sheets("donnees").Range("A" & enviunit + 1).Select
       Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False

    End If

   ' =========== comparaison de dates
   For t = 1 To 1000000
       enviunit = t - 1
       If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
   Next
   datextract = Format(Sheets("travail").Cells(2, lacol).Value, "yyyy-mm-dd")
   Sheets("donnees").Select
   ActiveWorkbook.Worksheets("donnees").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("donnees").Sort.SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("donnees").Sort
       .SetRange Range("A1:D" & enviunit)
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
   ActiveWorkbook.Worksheets("donnees").Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("donnees").Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("donnees").Sort
       .SetRange Range("A1:D" & enviunit)
       .Header = xlNo
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With

    'colle les valeurs pour cet environnement/date
    Sheets("donnees").Cells(1, 5).Value = datextract
    Sheets("donnees").Cells(1, 5).Value = Sheets("donnees").Cells(1, 5).Value
    For t = 1 To 1000000
        enviunit = t - 1
        If Sheets("donnees").Cells(t, 1).Value = "" Then Exit For
    Next
    Sheets("donnees").Range(Cells(1, 5), Cells(enviunit, 5)).FillDown
    Sheets("donnees").Range(Cells(1, 1), Cells(enviunit, 5)).Copy
    For t = 1 To 1000000
        enviunit = t - 1
        If Sheets("donneestemp").Cells(t, 1).Text = "" Then Exit For
    Next
    Sheets("donneestemp").Select
    Sheets("donneestemp").Cells(enviunit + 1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next

'met en forme l'onglet données
Application.StatusBar = "Traitement des données"
Sheets("donneestemp").Cells(1, 6).FormulaLocal = "=CONCATENER(SI(JOUR(E1)<10;""0"";"""");JOUR(E1);""/"";SI(MOIS(E1)<10;""0"";"""");MOIS(E1);""/"";ANNEE(E1);""___"";D1)"
For t = 2 To 1000000
    enviunit = t - 1
    If Sheets("donneestemp").Cells(t, 1).Value = "" Then Exit For
Next
Sheets("donneestemp").Select
Sheets("donneestemp").Range(Cells(1, 6), Cells(enviunit, 6)).FillDown

Sheets("donneestemp").Cells(1, 7).FormulaLocal = "=A1"
Sheets("donneestemp").Range(Cells(1, 7), Cells(enviunit, 7)).FillDown
Sheets("donneestemp").Range(Cells(1, 7), Cells(enviunit, 7)).Select
Selection.Copy
Sheets("donneestemp").Select
Sheets("donneestemp").Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("donneestemp").Range(Cells(1, 6), Cells(enviunit, 6)).Select
Selection.Copy
Sheets("donneestemp").Select
Sheets("donneestemp").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False

' =========== supprimer les doublons de composants
Application.ScreenUpdating = True
Sheets("donneestemp").Select
Sheets("donneestemp").Range("$G$1:$G$" & enviunit).RemoveDuplicates Columns:=1, Header:=xlNo
Application.ScreenUpdating = False
For t = 2 To 1000000
    enviunit = t - 1
    If Sheets("donneestemp").Cells(t, 1).Value = "" Then Exit For
Next
Sheets("donneestemp").Select
Sheets("donneestemp").Range("G1:G" & enviunit).Copy
Sheets("travail").Select
Sheets("travail").Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
For t = 3 To 1000000
    enviunit = t - 1
    If Sheets("travail").Cells(t, 1).Value = "" Then Exit For
Next

' =========== applique les spécificités
If InStr(1, Sheets("travail").Cells(1, maxcompare).Value, "-") > 0 Then
    colspec = Split(Sheets("travail").Cells(1, maxcompare).Value, "-")(1)
    nomenvbord = Sheets("travail").Range(colspec & 1).Text
    For ligne = 3 To enviunit
        Application.StatusBar = "Applications :" & ligne & "/" & enviunit
        valeurs = Split(Sheets("travail").Cells(ligne, 1).Value, "___")
        lignemax = ligne
        
        'specificités packaging
        For parclign = 2 To 100000
            If Sheets("Spécificités").Cells(parclign, 1).Value = "" Then Exit For
            If LCase(valeurs(0)) = LCase(Sheets("Spécificités").Cells(parclign, 1).Value) Then
                'premier champs
                onatrouveprem = 0
                If LCase(valeurs(1)) = LCase(Sheets("Spécificités").Cells(parclign, 2).Value) Then
                    onatrouveprem = 1
                End If
                If LCase(valeurs(1)) = "" Then
                    onatrouveprem = 1
                End If
                If InStr(1, Sheets("Spécificités").Cells(parclign, 2).Value, "*") > 0 Then
                    avantetoile = Split(Sheets("Spécificités").Cells(parclign, 2).Value, "*")(0)
                    apresetoile = Split(Sheets("Spécificités").Cells(parclign, 2).Value, "*")(1)
                    If Left(valeurs(1), Len(avantetoile)) = avantetoile And Right(valeurs(1), Len(apresetoile)) = apresetoile Then
                        onatrouveprem = 1
                    End If
                End If
    
                'deuxième champs
                onatrouve = 0
                If LCase(valeurs(2)) = LCase(Sheets("Spécificités").Cells(parclign, 3).Value) Then
                    onatrouve = 1
                End If
                If LCase(valeurs(2)) = "" Then
                    onatrouve = 1
                End If
                If InStr(1, Sheets("Spécificités").Cells(parclign, 3).Value, "*") > 0 Then
                    avantetoile = Split(Sheets("Spécificités").Cells(parclign, 3).Value, "*")(0)
                    apresetoile = Split(Sheets("Spécificités").Cells(parclign, 3).Value, "*")(1)
                    If Left(valeurs(2), Len(avantetoile)) = avantetoile And Right(valeurs(2), Len(apresetoile)) = apresetoile Then
                        onatrouve = 1
                    End If
                End If
                trouver = 0
                If onatrouveprem = 1 And onatrouve = 1 Then
                    For lao = 6 To 100000
                        If Sheets("Spécificités").Cells(1, lao).Value = "" Then Exit For
                        If LCase(Sheets("Spécificités").Cells(parclign, lao).Text) = "x" And LCase(nomenvbord) = LCase(Sheets("Spécificités").Cells(1, lao).Text) Then
                            trouver = 1
                            Sheets("travail").Rows(ligne & ":" & ligne).RowHeight = Sheets("travail").Rows("1:1").RowHeight
                            If Sheets("Spécificités").Cells(parclign, 4).Value = "suppression" Then
                                    Sheets("travail").Rows(ligne & ":" & ligne).RowHeight = 0
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 228352 bytes
SHA-256: 0f56925f1352709534f732a6c2024f1ea8154e0b796ef51ad1654f36effc3f80

Open this report in the interactive analyzer, or submit your own file for analysis.