Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 4edaf5e3febc198b…

MALICIOUS

Office (OOXML)

806.3 KB Created: 2020-10-01 14:54:47 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2021-06-04
MD5: 1828bd4a75f730fa8400d010bef95365 SHA-1: c298c8a97a6ef0f33afb252837a21d15759423f5 SHA-256: 4edaf5e3febc198b94faef2b15c2f82c4b0868c7cdf4a577e39d1006013b3f54
342 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1105 Ingress Tool Transfer T1204.002 Malicious File

The VBA macros within this Excel document contain critical heuristic firings for Shell() calls, WScript.Shell usage, and URLDownloadToFile, indicating malicious intent. The script attempts to download and execute a second-stage payload from one of the embedded URLs, likely leading to further compromise. The presence of cmd.exe references further supports the execution of arbitrary commands.

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
        'Vidage du cache
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Set Sh = CreateObject("WScript.Shell")
    ID = Sh.Run(Str_Wegg, 0, True)
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
                    'DeleteUrlCacheEntry URL
                URLDownloadToFile 0, URL & Fic, Workbooks("Gestionnaire UTB.xlsm").Path & "\Images\monImage.jpg", 0, 0
                .zIdentité.Picture = LoadPicture(Workbooks("Gestionnaire UTB.xlsm").Path & "\Images\monImage.jpg")
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
        'Vidage du cache
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                Dim fso As New FileSystemObject
            Set fso = CreateObject("Scripting.FileSystemObject")
            Dim Fic, URL
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
        Dim i, tmp, Serveur_Distant, Str_Wegg, ID, Sh
    Str_Wegg = "cmd /c " & Chr(34) & "net view >" & Workbooks("Gestionnaire UTB.xlsm").Path & "\Serveurs.txt" & Chr(34)
  • 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://chart.googleapis.com/chart?cht=qr Referenced by macro
    • http://utbmontceau.fr/Conferences/Referenced by macro
    • http://utbmontceau.fr/Voyages/Photos/Referenced by macro
    • http://utbmontceau.fr/Referenced by macro
    • https://chart.googleapis.com/chartReferenced by macro
    • http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.aspReferenced by macro
    • http://www.kubiszyn.co.ukReferenced by macro
    • http://utbmontceau.fr/Conferences/5Referenced by macro
    • http://schemas.microsoft.com/office/2006/01/customuiReferenced by macro
    • http://api.qrserver.com/v1/create-qr-code/?data=Referenced by macro
    • https://developers.google.com/chart/infographics/docs/qr_codesReferenced by macro
    • http://api.qrserver.com/v1/create-qr-code/?data=5Referenced 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) 906938 bytes
SHA-256: 61175c7b0d4010a0f732725e69f31bb36ebbbdf9909c23b71df663d9d5c81498
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

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 = "Feuil1"
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 = "Feuil3"
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 = "frmAdhérents"
Attribute VB_Base = "0{AF150791-F013-4F4B-A402-54B04D3CB076}{C4AF87F9-061C-439A-8086-CADA9CF6E9EF}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
        "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    Public GetOut As Boolean
    'pour enlever la croix rouge d'une userform
     Private Declare PtrSafe Function GetWindowLongA Lib "User32" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
     
     Private Declare PtrSafe Function SetWindowLongA Lib "User32" _
    (ByVal hWnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
     
     Private Declare PtrSafe Function FindWindowA Lib "User32" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
    Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
        "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    Public GetOut As Boolean
    'pour enlever la croix rouge d'une userform
     Private Declare Function GetWindowLongA Lib "User32" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
     
     Private Declare Function SetWindowLongA Lib "User32" _
    (ByVal hWnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
     
     Private Declare Function FindWindowA Lib "User32" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

#End If
'--- Subclassing ---
'Implements Isubclasser
Private mtWin1 As SubClassedWindow
'-------------------

' handle de la fenêtre
Private hUserForm As Long

'#If VBA7 Then
'Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
'#Else
   ' Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'#End If
' trouve l'handle d'une fenêtre via son titre
'Office 2010
'Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
'Office 2007
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
'

' fonction qui récupère l'handle de notre fenêtre
Private Function GetFormHandle(frm As UserForm) As Long
Exit Sub
    Const CLASS_USERFORM As String = "ThunderDFrame"
    GetFormHandle = FindWindow(CLASS_USERFORM, frm.Caption)
End Function

Private Sub CommandButton1_Click()
     pListe_Adhérents "frmAdhérents", " from adherents where statut is null or statut =''"
     With Me
        .Label193.Caption = "Retraits base"
        .Label60.Caption = "Liste des noms des personnes de la base restreinte"
     End With
End Sub

Private Sub CommandButton2_Click()
    mdlCartes.Editions_Cartes_New
End Sub

Private Sub Label194_Click()
MsgBox "Attention, les boutons ne sont plus gérés par l'application."
With Me
    .zNouveau.Enabled = True
    .zEnregistrer.Enabled = True
    .zEnregistrer.Visible = True
    .zModifier.Enabled = True
    .zModifier.Visible = True
    .zSupprimer.Enabled = True
    .zSupprimer.Visible = True
    .zCarte_New.Enabled = True
    .zCarte_New.Visible = False
End With
End Sub

Private Sub Label60_Click()

End Sub

Private Sub OptionButton1_Click()
    With frmAdhérents
        .Frame10.Caption = "Supplément"
        .Label206.Visible = True
        .zSupplément.Visible = True
        .zCollocataire.Visible = False
    End With
End Sub

Private Sub OptionButton2_Click()
    With frmAdhérents
        .Frame10.Caption = "Partagée avec"
        .Label206.Visible = False
        .zSupplément.Visible = False
        .zCollocataire.Visible = True
    End With
End Sub

Private Sub OptionButton3_Click()
     With frmAdhérents
        .Frame10.Caption = "Partagée avec"
        .Label206.Visible = False
        .zSupplément.Visible = False
        .zCollocataire.Visible = True
    End With
End Sub

Private Sub SpinButton1_Change()
   
End Sub

Private Sub SpinButton1_SpinDown()
 With ActiveSheet.Shapes("Identité")
        .Left = .Left - 1
    End With
End Sub


Private Sub SpinButton1_SpinUp()
With ActiveSheet.Shapes("Identité")
        .Left = .Left + 1
    End With
End Sub

Private Sub UserForm_Activate()
    Call HookMouse(Me.zListe_Adhérents, eUSERFORM, Me.Name)
    With Fc(32)
        .Shapes("zAperçu").Visible = False
        .Shapes("zAperçu_Edition_Badge").Visible = True
    End With
Exit Sub
'Supprime la croix
    Dim hWnd As Long
    hWnd = FindWindow("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
End Sub


Private Sub UserForm_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 With ActiveSheet.Shapes("Identité")
        .Left = .Left + 1
    End With
End Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Workbooks("Gestionnaire UTB.xlsm").Activate
    UnHookMouse
Exit Sub
   'If Not GetOut Then MsgBox "Merci d'utiliser le bouton 'Quitter' pour terminer", 64, "Transaction interdite"
    Cancel = True
End Sub

Private Sub UserForm_Terminate()
Exit Sub
    TerminateSubClassing mtWin1
End Sub
Private Sub CheckBox15_Click()
    pCentre CheckBox15.Name
End Sub

Private Sub CheckBox16_Click()
     pCentre CheckBox16.Name
End Sub

Private Sub CheckBox17_Click()
     pCentre CheckBox17.Name
End Sub

Private Sub CheckBox18_Click()
     pCentre CheckBox18.Name
End Sub

Private Sub CheckBox19_Click()
     pCentre CheckBox19.Name
End Sub
Private Sub CheckBox20_Click()
     pCentre CheckBox20.Name
End Sub

Private Sub CheckBox29_Click()
 pCentre CheckBox29.Name
End Sub
Private Sub CheckBox30_Click()
 pCentre CheckBox30.Name
End Sub

Private Sub Label135_Click()
    With frmCalendrier
        .zAnnée.Visible = False
        .Label1.Visible = False
        .Calendar1.Tag = "frmAdhérents_Conférences"
        .Calendar1.Value = Now
        .Show
    End With
End Sub

Sub pCentre(Checkbox)

    If Controls(Checkbox).Tag = "" And Controls(Checkbox).Caption = "" And Controls(Checkbox).Value = True Then
        Select Case Right(Controls(Checkbox).Name, 2)
            Case 15 To 20
                frmCentre.Label1 = "Centre d'intérêt :"
            Case 29 To 30
                frmCentre.Label1 = "Passion :"
        End Select
        With frmCentre
            .zCentre = ""
            .zCentre.SetFocus
            .Caption = Space(30) & "U.T.B. Antenne de Montceau"
            .Show
        End With
        Select Case Ret
            Case 0
                Controls(Checkbox).Value = False
                'Controls(Checkbox).Caption = ""
                Exit Sub
            Case 1
                Controls(Checkbox).Caption = frmCentre.zCentre
            End Select
        
    Else
        Controls(Checkbox).Caption = ""
        Controls(Checkbox).Tag = ""
      
    End If
End Sub

Private Sub Label147_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If frmAdhérents.MultiPage1.Value = 0 Then
        frmAdhérents.zDate = ""
        With frmCalendrier
            '.zAnnée.SetFocus
            .zAnnée.Visible = True
            .Label1.Visible = True
            .Calendar1.Tag = "frmAdhérents"
            .Show
        End With
    End If
End Sub
Private Sub Label183_Click()
    With frmCalendrier
        .Calendar1.Tag = "frmAdhérents_Voyages"
        .Calendar1.Value = Now
        .Show
    End With
End Sub
Private Sub Label192_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With Me
      
        If .zStatut_Ex = "" Then
            .zStatut_Ex = "R"
            .Label192 = "Réintégration base :"
        Else
            .zStatut_Ex = ""
            .Label192 = "Retrait base :"
        End If
    End With
End Sub

Private Sub Label193_Click()
    Application.ScreenUpdating = False
  
    With Me.Label193
        Select Case .Caption
            Case "Base complète"
                .Caption = "Base opérationnelle"
                .ForeColor = RGB(255, 0, 0)
                'Msg = " where statut is null or statut =''"
                msg = "from adherents "
                Msg_1 = "Liste des personnes de la base complète"
            Case "Base opérationnelle"
                .Caption = "Retraits base"
                .ForeColor = RGB(255, 0, 0)
                'Msg = " where statut ='R'"
                msg = " from adherents where statut is null or statut =''"
                Msg_1 = "Liste des personnes de la base opérationnelle"
            Case "Retraits base"
                If Fc(2).Range("Profil") = 1 Or Fc(2).Range("Profil") = 7 Then
                        .Caption = "Base adhérents"
                        .ForeColor = RGB(0, 0, 0)
                         'Msg = ""
                        msg = " from adherents where statut ='R'"
                        Msg_1 = "Liste des personnes de la base des retraits"
                Else
                        .Caption = "Base complète"
                        .ForeColor = RGB(0, 0, 0)
                        'Msg = ""
                        msg = " from adherents where statut ='R'"
                        Msg_1 = "Liste des personnes de la base des retraits"
                End If
            Case "Base adhérents"
               .Caption = "Base complète"
                .ForeColor = RGB(0, 0, 0)
                'Msg = ""
                msg = " from adherents, inscriptions_conferences where adherents.id_adherent=inscriptions_conferences.id_adherent and inscriptions_conferences.saison ='" & Fc(2).Range("saison") & "'"
                Msg_1 = "Liste des personnes de la base des adhérents"
        End Select
    End With
    frmAdhérents.Label60 = Msg_1
    pListe_Adhérents "frmAdhérents", msg
   ' frmAdhérents.zListe_Adhérents.ListIndex = 0
End Sub

Private Sub MultiPage1_Change()
    Dim Année_en_cours, Année
    'pRépertoire
    'Stop
    Saison = Workbooks("Gestionnaire UTB.xlsm").Sheets("Paramètres").Range("Saison")
    Année_en_cours = Year(Now)
    Année = 2012
    'pNouvelle_Inscription
Début:
    With frmAdhérents
        pListe_Etablissements_bancaires frmAdhérents.zID_Adhérent, .MultiPage1.Value
        If .zID_Adhérent <> "" Then
            pListe_Inscriptions .zID_Adhérent
        End If
        'Année = 2012
        'With .zSaison
           ' .Clear
           ' Do
                '.AddItem (Année_en_cours & "/" & Année_en_cours + 1)
               ' Année_en_cours = Année_en_cours - 1
           ' Loop Until Année_en_cours = Année - 1
            '.ListIndex = pIndex_Saison
      
        'End With
            .zNouveau.Visible = True
            pLock_Delock_Entête False
        Select Case .MultiPage1.Value
            
            Case 0 'Coordonnées adhérent
                pLock_Delock_Entête True
                '.zCarte.Visible = True
                Select Case .zTitre
                    Case "Mme", "Melle"
                        .Label178 = "Contactée par :"
                    Case "M."
                        .Label178 = "Contacté par :"
                End Select
                With .zModifier
                    .Caption = "Modifier"
                    .Visible = True
                End With
               '.zEnregistrer.Visible = True
                If .zID_Adhérent = "" Then
                    .zNouveau.Enabled = False
                    .zEnregistrer.Enabled = True
                    .zQuitter.Enabled = True
                    .zModifier.Enabled = False
                    .zSupprimer.Enabled = False
                Else
                    .zNouveau.Enabled = True
                    .zEnregistrer.Enabled = False
                    .zQuitter.Enabled = True
                    'If Profil <> "V" Then
                        .zSupprimer.Enabled = False
                        .zModifier.Enabled = True
                   ' Else
                        '.zSupprimer.Enabled = False
                        '.zModifier.Enabled = False
                    'End If
                End If
                .zMessages = ""
            Case 1 'Inscription conférences
                '.zSaison = ""
                '.zCarte.Visible = True
                .zSaison.ListIndex = pIndex_Saison
                   'With .zModifier
                    '.Caption = "Modifier"
                    '.Visible = True
                    '.Enabled = False
               ' End With
                '.zEnregistrer.Visible = True
                If .zSaison = Fc(2).Range("Saison") Then
                     If .zID_Inscription_Conférences = "" Then
                        '.zEnregistrer.Enabled = True
                        '.zModifier.Enabled = False
                        '.zQuitter.Enabled = True
                        '.zSupprimer.Enabled = False
                        msg = "Nouvelle inscription pour la saison : " & .zSaison & " ?"
                    Else
                        '.zEnregistrer.Enabled = False
                        '.zModifier.Enabled = True
                        '.zQuitter.Enabled = True
                        '.zSupprimer.Enabled = True
                        .zNouveau.Enabled = False
                       msg = "Inscription existante pour la saison " & .zSaison
                    End If
                Else
                End If
               ' If .zID_Inscription_Conférences = "" Then
                    '.zEnregistrer.Enabled = True
                    '.zModifier.Enabled = False
                    '.zQuitter.Enabled = True
                    '.zSupprimer.Enabled = False
               ' Else
                     '.zEnregistrer.Enabled = False
                     '.zModifier.Enabled = True
                     '.zQuitter.Enabled = True
                     '.zSupprimer.Enabled = True
               ' End If
                    '.zNouveau.Visible = True
                '.zListe_Inscriptions.ListIndex = 0
                '.zDate = "01/01/1900"
                '.zDate = ""
                .zMessages = msg
             Case 2 'Inscription voyages
             .zCarte.Visible = False
               .zModifier.Caption = "Modifier"
                If .zID_Inscription_Voyages = "" Then
                     .zEnregistrer.Enabled = True
                     .zModifier.Enabled = False
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = False
                Else
                     .zEnregistrer.Enabled = False
                     .zModifier.Enabled = True
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = True
                End If
                '.zListe_Inscriptions.ListIndex = 0
                .zMessages = ""
            Case 3 'Bureau
            .zCarte.Visible = False
               .zModifier.Caption = "Modifier"
                If .zID_Nomination = "" Then
                     .zEnregistrer.Enabled = True
                     .zModifier.Enabled = False
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = False
                Else
                     .zEnregistrer.Enabled = False
                     .zModifier.Enabled = True
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = True
                End If
                 .zMessages = ""
                
            Case 4 ' Bénévolat
                '.zMembre = True
                '.zNon = True
                .zCarte.Visible = False
                 .zModifier.Caption = "Modifier"
                If .zID_Inscription_Conférences = "" Then
                     .zEnregistrer.Enabled = True
                     .zModifier.Enabled = False
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = False
                Else
                     .zEnregistrer.Enabled = False
                     .zModifier.Enabled = True
                     .zQuitter.Enabled = True
                     .zSupprimer.Enabled = True
                End If
                 .zMessages = ""
            Case 5 ' Réseau
                '.zMembre = True
                '.zNon = True
                .zCarte.Visible = False
                .Label174.Caption = "Liste des personnes contactées par : " & Chr(10) & .zTitre & " " & .zNom & " " & .zPrénom
                    '.zModifier.Caption = "Ajouter"
                  
                If .zID_Contacts = "" Then
                    .zNouveau.Visible = True
                    .zEnregistrer.Visible = False
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                Else
                    .zNouveau.Visible = True
                    .zEnregistrer.Visible = False
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = True
                End If
                    .zNouveau.Visible = True
                 .zMessages = ""
            Case 6 'Centres d'intérêts
                .zCarte.Visible = False
                If .zID_Centre = "" Then
                    .zNouveau.Visible = False
                    .zEnregistrer.Visible = True
                    .zEnregistrer.Enabled = True
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                Else
                    .zNouveau.Visible = False
                    .zEnregistrer.Visible = False
                    .zModifier.Enabled = True
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = True
                End If
                 .zMessages = ""
                    'Dim ll
                   ' Dim ctrl As Control
                   ' Dim I As Integer
                    'For Each ctrl In frmAdhérents.MultiPage1.Pages(6).Controls
                    
                    ' If TypeName(ctrl) = "CheckBox" And ctrl.Tag = "1" Then
                       
                          ' Nom = ctrl.Name
                            'If Controls(Nom).Caption = "" Or Right(Controls(Nom).Caption, 1) = " " And Controls(Nom).Value = True Then
                                'frmCentre.Show
                                'Select Case Ret
                                    'Case 0
                                     'Controls(Nom).Value = False
                                     'Controls(Nom).Caption = ""
                                        'Exit Sub
                                    'Case 1
                                        
                                   'Controls(Nom).Caption = frmCentre.zCentre & " "
                                'End Select
        
                           ' Else
                           'Controls(Nom).Caption = ""
                           ' End If
                  
                     'End If
                   ' Next ctrl
                    'UserForm1.Label1.Caption = I
                    'Set Ctrl = Nothing
                Case 7 'Participations aux conférences
                    pListe_Saisons "frmAdhérents-Participations"
                    .zNouveau.Visible = False
                    .zEnregistrer.Visible = False
                    .zModifier.Visible = False
                    .zQuitter.Visible = True
                    .zSupprimer.Visible = False
                    .zCarte.Visible = False
                    .Label207 = "Synthèse des participations de la saison : " & frmAdhérents.zSaison_Participation
                    pListe_Participations .zID_Adhérent
        End Select
      
    End With
End Sub


Private Sub MultiPage1_Click(ByVal index As Long)
If index <> 6 Then Exit Sub
GoTo suite
    If CheckBox15.Caption = "" Or Right(CheckBox15.Caption, 1) = " " And CheckBox15.Value = True Then
        frmCentre.Show
        Select Case Ret
            Case 0
                CheckBox15.Value = False
                CheckBox15.Caption = ""
                'Exit Sub
            Case 1
                
            CheckBox15.Caption = frmCentre.zCentre & " "
        End Select
        
    Else
       
        CheckBox15.Caption = ""
    End If
suite:


End Sub


Private Sub zBureau_Click()
    With frmAdhérents
        .Label133.Visible = True
        .zFonction.Visible = True
        .Label170.Visible = True
        .zDate_Nomination.Visible = True
        .zStatut = "B"
    End With
End Sub
Private Sub zBureau_Elargi_Click()
    With frmAdhérents
        .Label133.Visible = True
        .zFonction.Visible = True
        .Label170.Visible = True
        .zDate_Nomination.Visible = True
        .zStatut = "BE"
    End With
End Sub

Private Sub zChoix_Contacts_Click()
 Dim i, L
    If frmAdhérents.zChoix_Contacts.ListCount = 0 Then
        'pNouvelle_Inscription_Voyage
        Exit Sub
    End If
    For i = 0 To frmAdhérents.zChoix_Contacts.ListCount - 1
        If frmAdhérents.zChoix_Contacts.Selected(i) = True Then
            L = i
            GoTo suite
        Else
            'pNouvelle_Inscription
            'Exit Sub
        End If
    Next
suite:
    With frmAdhérents
        .zID_Contact = frmAdhérents.zChoix_Contacts.List(L, 0)
        .zTitre_Contact = frmAdhérents.zChoix_Contacts.List(L, 1)
        .zNom_Contact = frmAdhérents.zChoix_Contacts.List(L, 2)
        .zPrénom_Contact = frmAdhérents.zChoix_Contacts.List(L, 3)
        .zID_Contacts = frmAdhérents.zChoix_Contacts.List(L, 4)
        .zSupprimer.Enabled = False
        .zEnregistrer.Enabled = True
        .zEnregistrer.Caption = "Ajouter"
    End With
Fin:
End Sub

Private Sub zCarte_Click()
    pInit
    Dim test, rep, Accord, Comp, Accord1
    With Workbooks("Editions.xlsm")
        .Activate
        .Sheets("Cartes").Select
    End With
    mdlCartes.Editions_Cartes
    GoTo suite
'Carte vierge
   ' mdlCartes.pCarte_Vierge
        
'Vérification de l'inscription
    With frmAdhérents
        test = pControle_Inscription_Conférences(.zID_Adhérent, Fc(2).Range("Saison"))
        If .zTitre = "M." Then
            Comp = ""
        Else
            Comp = "e"
        End If
        Select Case test
            Case 0
                rep = MsgBox("Attention." & Chr(10) & .zTitre & " " & .zPrénom & " " & .zNom & " n'est pas adhérent" & Comp & " pour la saison : " & Fc(2).Range("Saison") & Chr(10) & "Confirmez l'édition.", vbYesNo, "Edition du badge")
                Select Case rep
                    Case 7
                        Accord = 0
                    Case 6
                        Accord = 1
                End Select
            Case Else
                Accord = 1
        End Select

'Vérification du pointage de l'édition
        If .zBadge = True Then
                rep = MsgBox("Attention. Le badge de " & Chr(10) & .zTitre & " " & .zPrénom & " " & .zNom & " a dèjà été édité." & Chr(10) & "Confirmez l'édition.", vbYesNo, "Edition du badge")
                Select Case rep
                    Case 7
                        Accord1 = 0
                    Case 6
                        Accord1 = 1
                End Select
                Else
                Accord1 = 1
        End If
        End With

'Edition
    If Accord = 1 And Accord1 = 1 Then
        mdlCartes.Editions_Cartes
        'Pointage de l'édition
        frmAdhérents.zBadge = True
        pModifier_Inscription
    Else

    End If
suite:
     With ActiveWindow
        .ScrollColumn = 1
        .ScrollRow = 1
    End With
    Application.ScreenUpdating = True
End Sub
Sub pAperçu()
    Fc(24).PrintPreview
End Sub

Private Sub zCarte_New_Click()
    mdlCartes.Editions_Cartes_New
End Sub

Private Sub zCode_Postal_Change()
    mdlAdhérents.pListe_Villes
End Sub



Private Sub zDate_Change()
    With frmAdhérents
        If .zDate = "" Then
            Select Case .zID_Inscription_Conférences
                Case Is <> ""
                    .zModifier.Enabled = True
                    '.zEnregistrer.Enabled = False
                Case Else
                    .zEnregistrer.Enabled = False
                    '.zModifier.Enabled = False
            End Select
        Else
            Select Case .zID_Inscription_Conférences
                Case Is <> ""
                    .zModifier.Enabled = True
                    .zEnregistrer.Enabled = False
                Case Else
                    '.zEnregistrer.Enabled = True
                    .zModifier.Enabled = False
            End Select
        End If
        
    End With
End Sub
Private Sub zDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With frmCalendrier
        .Calendar1.Tag = "frmAdhérents_Conférences"
        .Calendar1.Value = Now
        .Show
    End With
End Sub
Private Sub zDate_Naissance_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
MsgBox "33"
End Sub
Private Sub zDate_Nomination_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With frmCalendrier
        .Calendar1.Tag = "frmAdhérents_Bureau"
        .Calendar1.Value = Now
        .Show
    End With
End Sub



Private Sub zDl_Horizontal_SpinDown()

 With Fc(24)
    Sh = ""
    With frmBadge
        If .zPhoto_Identité = True Then Sh = "Identité"
        If .zCode = True Then Sh = "Code"
        If .zCoordonnées = True Then Sh = "Coordonnées"
        If .zPs = True Then Sh = "Nota"
   End With
    With .Shapes(Sh)
        .Left = .Left + 1
    End With
End With
End Sub

Private Sub zDl_Horizontal_SpinUp()

 With Fc(24)
    Sh = ""
    With frmBadge
        If .zPhoto_Identité = True Then Sh = "Identité"
        If .zCode = True Then Sh = "Code"
        If .zCoordonnées = True Then Sh = "Coordonnées"
        If .zPs = True Then Sh = "Nota"
   End With
    With .Shapes(Sh)
        .Left = .Left + 1
    End With
End With
End Sub

Private Sub zEdit_Click()
   ' mdlUtilitaires.pRafraichissement_Badge val(Fc(2).Range("Modèle_Badge"))
    mdlCartes.Editions_Cartes_New_1
End Sub

Private Sub zEnregistrer_Click()
    Ret = 1
    frmAdhérents.Hide
End Sub

Private Sub zEtablissement_Bancaire_Click()
    'Call HookMouse(Me.zEtablissement_Bancaire, eUSERFORM, Me.Name)
    UnHookMouse
End Sub

Private Sub zEtablissement_Bancaire_Enter()
    'UnHookMouse
    Call HookMouse(Me.zEtablissement_Bancaire, eUSERFORM, Me.Name)
End Sub

Private Sub zEtablissement_Bancaire_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    UnHookMouse
End Sub

Private Sub zEtablissement_Bancaire_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
   ' Me.zEtablissement_Bancaire.SetFocus
End Sub

Private Sub zID_Adhérent_Change()
    With frmAdhérents
        Select Case .MultiPage1.Value
            Case 0 ' Coordonnées
                If .zID_Adhérent = "" Then
                    If .zNom <> "" Then
                        .zEnregistrer.Enabled = True
                    Else
                         .zEnregistrer.Enabled = False
                    End If
                    .zQuitter.Enabled = True
                    .zModifier.Enabled = False
                    .zSupprimer.Enabled = False
                    .zNouveau.Enabled = False
                    With .MultiPage1
                        .Pages(1).Enabled = False
                        .Pages(2).Enabled = False
                        .Pages(3).Enabled = False
                        .Pages(4).Enabled = False
                        .Pages(5).Enabled = False
                        .Pages(6).Enabled = False
                    End With
                Else
                    .zEnregistrer.Enabled = False
                    .zQuitter.Enabled = True
                    'If Profil <> "V" Then
                        '.zSupprimer.Enabled = True
                        '.zModifier.Enabled = True
                   ' Else
                        .zSupprimer.Enabled = False
                        .zModifier.Enabled = True
                   ' End If
                   With .MultiPage1
                        .Pages(1).Enabled = True
                        .Pages(2).Enabled = True
                        .Pages(3).Enabled = True
                        .Pages(4).Enabled = True
                        .Pages(5).Enabled = True
                        .Pages(6).Enabled = True
                    End With
                        
                    .zNouveau.Enabled = True
                End If
            Case 2 '
        End Select
        
        '.zID_Inscription_Conférences = ""
        '.zListe_Inscriptions.Clear
    End With
End Sub

Private Sub zID_Nomination_Change_1()
    With frmAdhérents
        .zFonction = pFonction(ID_Fonction)
    End With
End Sub

Private Sub zID_Centre_Change()
  With frmAdhérents
    Select Case .MultiPage1.Value
        Case 6 ' Centres d'intérêts
        If .zID_Centre = "" Then
            .zEnregistrer.Enabled = True
            .zQuitter.Enabled = True
            .zModifier.Enabled = False
            .zSupprimer.Enabled = False
        Else
            .zEnregistrer.Enabled = False
            .zQuitter.Enabled = True
            .zModifier.Enabled = True
            .zSupprimer.Enabled = True
        End If
    End Select
    End With
End Sub

Private Sub zID_Contact_Change()
 With frmAdhérents
        Select Case .MultiPage1.Value
            Case 0
            Case 5 ' Réseau
                'If .zID_Contact = .zID_Adhérent Or mdlAdhérents.pExistence_Contact(.zID_Contact) >= 1 Or pExistence_Email(.zID_Contact) >= 1 Then
                 If .zID_Contact = .zID_Adhérent Then
                    '.zEnregistrer.Enabled = True
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                    MsgBox ("Ce contact est soit l'adhérent, soit un contact déjà enregisté, soit un contact disposant d'une adresse email")
                Else
                    '.zEnregistrer.Enabled = False
                    .zModifier.Enabled = True
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                    
               End If
       End Select
    End With
End Sub

Private Sub zID_Contacts_Change()
 With frmAdhérents
        Select Case .MultiPage1.Value
            Case 0
            Case 5 'Réseau
                If .zID_Contacts <> "" Then
                    '.zEnregistrer.Enabled = True
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = True
                    
                Else
                    '.zEnregistrer.Enabled = False
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                    
               End If
       End Select
    End With
End Sub

Private Sub zID_Inscription_Voyages_Change()
    
    With frmAdhérents
        Select Case .MultiPage1.Value
            Case 2
                If .zID_Inscription_Voyages = "" Then
                    .zEnregistrer.Enabled = True
                    .zModifier.Enabled = False
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = False
                    .zListe_Inscriptions.Clear
                    .Label166.Visible = True
                    .Label164.Visible = True
                    .zCapacité.Visible = True
                    .zDisponibilité.Visible = True
                    .zListe_Voyages.Enabled = True
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 2082304 bytes
SHA-256: b77e271ddcacc2305145c79d2ff280dad79dcf7fa22b02cdf4c5ed1ac4707662

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