Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 1acad897472619a6…

MALICIOUS

Office (OOXML)

1.58 MB Created: 2020-10-01 14:54:47 UTC Authoring application: Microsoft Excel 16.0300 First seen: 2020-10-09
MD5: d8a6fa67562bfcff6207d3966ffc8e6a SHA-1: 8b74e9640d3f33b7c3889f4988609f32042de3f1 SHA-256: 1acad897472619a6cdbae1fceaa67d0cf7b3e44bc7c5492b138b7adc0e5e8133
606 Risk Score

Heuristics 16

  • VBA project inside OOXML medium 13 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
        Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
                    URLDownloadToFile 0, URL & Fic, Workbooks("Gestionnaire UTB.xlsm").Path & "\Images\monImage.jpg", 0, 0
  • LOLBin reference in VBA critical OLE_VBA_LOLBIN
    LOLBin reference in VBA
    Matched line in script
        Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "
  • VBA stages a PowerShell/LOLBin download-and-run command critical OLE_VBA_BITSTRANSFER_DROPPER
    The macro assembles a download command using a PowerShell or LOLBin download primitive (Start-BitsTransfer, Invoke-WebRequest, Net.WebClient, bitsadmin, certutil, ...) that fetches a remote payload, then executes it -- writing it to a script file and running it, or launching it directly from an auto-exec handler. The keywords are commonly split with PowerShell backtick / cmd caret escapes to evade scanners; this detection de-escapes the source first. A high-confidence downloader/dropper, stronger than the individual Shell / download keywords on their own.
    Matched line in script
    Sub Auto_open()
  • VBA native-memory callback shellcode loader critical OLE_VBA_NATIVE_MEMORY_CALLBACK_LOADER
    VBA auto-exec macro declares or calls native memory allocation, process-memory write/copy, and callback/timer execution APIs. This is the in-memory shellcode loader pattern: allocate writable memory, copy decoded payload bytes into it, then transfer control through a callback such as CreateTimerQueueTimer. Benign document automation does not combine these primitives.
    Matched line in script
        Private Declare PtrSafe Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  • VBA email-worm self-replication (Outlook mass-mailer) critical OLE_VBA_EMAIL_WORM_SELF_REPLICATION
    VBA macro drives Outlook to mass-mail itself: it automates Outlook.Application, programmatically creates a mail item, and spreads by harvests recipients from the MAPI address book / inbox, attaches a file to the outgoing message, sends the message programmatically. Harvesting recipients from the address book / inbox and auto-attaching the carrier to outgoing messages is the defining behavior of the Melissa / LoveLetter / W97M mass-mailer worm lineage — there is no benign document use, independent of any AV signature.
    Matched line in script
        Set objmail = objol.CreateItem(olMailItem)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
                Set fso = CreateObject("Scripting.FileSystemObject")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
        Set oOutlook = GetObject(, "Outlook.Application")
  • cmd.exe reference in VBA high OLE_VBA_CMD
    cmd.exe reference in VBA
    Matched line in script
        Shell ("cmd /c " & Chr(34) & "net view >" & Workbooks("Gestionnaire UTB.xlsm").Path & "\Serveurs.txt" & Chr(34)) 'recup par cde dos net view liste pc
  • VBA polls global keyboard state (keylogger) high OLE_VBA_KEYLOGGER_SPYWARE
    The macro declares or calls a Win32 keystroke-monitoring API (GetAsyncKeyState, SetWindowsHookEx WH_KEYBOARD, or GetKeyboardState) to capture keystrokes system-wide. No legitimate document automation polls global key state; this is the core of a VBA keylogger, usually paired with active-window capture (GetForegroundWindow) and a log file. A high-confidence spyware behaviour independent of any download / Shell evidence.
    Matched line in script
        Private Declare PtrSafe Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_open()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
          Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus
  • External hyperlinks (9) low OOXML_EXTERNAL_HYPERLINKS
    Document contains 9 external hyperlinks — clickable URLs are stored as external relationships. First target: http://utbmontceau.fr/Logos_Badges/
  • 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://utbmontceau.fr/Conferences/ Referenced by macro
    • http://utbmontceau.fr/Cartes_Badges/Referenced by macro
    • http://utbmontceau.fr/Images/Referenced by macro
    • http://utbmontceau.fr/Logos_Badges/Referenced by macro
    • http://utbmontceau.fr/Voyages/Referenced by macro
    • http://chart.googleapis.com/chart?cht=qrReferenced 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.voila.net/images/utb_logo.pngReferenced by macro
    • http://utbmontceau.voila.netReferenced by macro
    • http://utbmontceau.fr/editorial.htmlReferenced by macro
    • http://utbmontceau.fr/images/utb_logo.pngReferenced by macro
    • http://utbmontceau.frReferenced by macro
    • http://utbmontceau.fr/covid.htmlReferenced by macro
    • http://utbmontceau.voila.net/images/laurencin1.jpgReferenced by macro
    • http://montceau-news.com/imagesPost/2015/03/PINETTE-29-03-15.jpgReferenced by macro
    • http://data.moviecovers.com/DATA/zipcache/SOSReferenced 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://www.google.com/url?q=http%3A%2F%2Futbmontceau.voila.net&sa=D&sntz=1&usg=AFQjCNEO7X4zslZV7ZkbvSnKULNQ_vv85wReferenced by macro
    • http://api.qrserver.com/v1/create-qr-QR_Code/?data=Referenced by macro
    • http://api.qrserver.com/v1/create-qr-code/?data=5Referenced by macro
    • https://developers.google.com/chart/infographics/docs/qr_codes0Referenced 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) 1989184 bytes
SHA-256: bcb939c9214c77e1476160b0cbb938851a22a898f809ef6b6ccc8841c2102b6a
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 = "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 = "frmAdhérents"
Attribute VB_Base = "0{68643B8A-24FD-47D5-95A3-E1F6B8E88965}{4F532484-9F37-4F4F-A5B3-87D90EC0ADB1}"
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
                Else
                    .zEnregistrer.Enabled = False
                    .zModifier.Enabled = True
                    .zQuitter.Enabled = True
                    .zSupprimer.Enabled = True
                    .Label166.Visible = False
                    .Label164.Visible = False
                    .zCapacité.Visible = False
                    .zDisponibilité.Visible = False
                    .zListe_Voyages.Enabled = False
                End If
            Case Else
        End Select
    End With
End Sub

Private Sub zID_Modèle_Badge_Change()
    'pSélection_Badge frmAdhérents.zId_Modèle_Badge
End Sub

Private Sub zID_Nomination_Change()
    With frmAdhérents
        Select Case .MultiPage1.Value
            Case 3
                 If .zID_Nomination = "" Then
                     .zEnregistrer.Enabled = True
                     .zModifier.Enabled = False
                     .zQuitter.Enabled = True
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 4355072 bytes
SHA-256: 358857f236e1a57300e9c9bee8acd6c093b8703be5905c052d83a3f504242e66

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