Microsoft 365 Simplification de code

Private Sub PLein_Ecran_Click()
Application.DisplayFullScreen = True
End Sub

Private Sub Quitter_Plein_Ecran_Click()
Application.DisplayFullScreen = False
End Sub

Private Sub Informations_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("BDD")
  
    ' Effacer les filtres existants
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
End If
  
    ' Appliquer le filtre pour "INFORMATIONS"
    ws.Range("C6").AutoFilter Field:=3, Criteria1:="INFORMATIONS"
 ws.Activate
End Sub
Private Sub Informations_Click()
Const nSec = 1
Dim fin, old, x
old = Informations.BackColor
Informations.BackColor = &H80FF&
fin = Now() + nSec / 24 / 60 / 60
Informations.BackColor = &HFF&
Label1 = "SOUS- PROCESSUS"
Sheets("RECUP DONNEES").Range("A2").Value = "INFORMATIONS"
Do: DoEvents: Loop While Now() <= fin
Informations.BackColor = old
End Sub

Sub MAIN()
STACK = "MAIN()"

    Dim vAppel As Variant
    Dim sType As String
    Dim sTitre As String
    Dim sTypeFiltre As String
    Dim sFiltre As String
    Dim sMessage As String
    Dim oShapeSource As Shape
    Dim oShapeCible As Shape
    Dim sShapeSource As String
    Dim sShapeCible As String
    
    
    On Error GoTo HANDLE_ERROR

    Set oSpeed = New SpeedMacro
    oSpeed.SpeedMacroOn
    
    Set oShapeSource = ActiveSheet.Shapes("ZONE_TEXTE_SOURCE")
    Set oShapeCible = ActiveSheet.Shapes("ZONE_TEXTE_CIBLE")
    
    sShapeSource = oShapeSource.TextFrame2.TextRange.Characters.Text
    sShapeCible = oShapeCible.TextFrame2.TextRange.Characters.Text
        
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    ' Classeur exécutant les macros de l'outil
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    Set gWB_MACRO = ThisWorkbook
        
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    ' Chargement de la table des paramètres
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    Set oParameters = New Cls_CollectionParameters
    Call oParameters.Instanciate
    
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    ' Chargement de la table des messages
    '*=*=*=*=*=*=*=*=*=*=*=*=*==*=*=*=*=*=*=*=*=*=*=*
    Set oMsg = New Cls_MessagesDialog
    Call oMsg.Intanciate
    
    Set gWK_MACRO = Sheets(WK_ACCUEIL)

    sType = TypeName(Application.Caller)
    Select Case sType
        Case "Range"
            vAppel = Application.Caller.Address
        Case "String"
            vAppel = Application.Caller
        Case "Error"
            vAppel = "Error"
        Case Else
            vAppel = "unknown"
    End Select
    
    If sType <> "String" Then
        MsgBox oMsg.GetMessage("M_MSG001"), vbExclamation, APPLI
        Error.Raise ERROR_PQW, ERROR_PQW_SOURCE, ERROR_PQW_MSG
        Exit Sub
    End If
    
    '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    ' Bouton de la source
    '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    Select Case vAppel
        Case "FOLDER_SOURCE"
            Call GET_FILE_NAME_XL(SOURCE)
            
        Case "FOLDER_CIBLE"
            Call GET_FILE_NAME_XL(CIBLE)
            
        Case "BTN_INVENTORIER_SOURCE", "SH_INVENTORIER_SOURCE"
            Call INVENTORIER(SOURCE, DIALOG)
            
        Case "BTN_INVENTORIER_CIBLE", "SH_INVENTORIER_CIBLE"
            Call INVENTORIER(CIBLE, DIALOG)
        
        Case "BTN_COPY_OFF"
            Call SET_OPTION_COLUMN("COPIE", SOURCE, SET_NON, DIALOG)
            
        Case "BTN_COPY_ON"
            Call SET_OPTION_COLUMN("COPIE", SOURCE, SET_OUI, DIALOG)
            
        Case "BTN_DATA_OFF"
            Call SET_OPTION_COLUMN("DATA", SOURCE, SET_NON, DIALOG)
            
        Case "BTN_DATA_ON"
            Call SET_OPTION_COLUMN("DATA", SOURCE, SET_OUI, DIALOG)
            
        Case "BTN_FORCE_OFF"
            Call SET_OPTION_COLUMN("FORCE", SOURCE, SET_NON, DIALOG)
            
        Case "BTN_FORCE_ON"
            Call SET_OPTION_COLUMN("FORCE", SOURCE, SET_OUI, DIALOG)
            
        Case "BTN_IMPORTER_CIBLE", "SH_IMPORTER_CIBLE"
            Call IMPORTER_QUERIES(DIALOG)
            
        Case "SH_IMPORTER_RQ_TXT"
            IMPORTER_QUERY_TXT (DIALOG)
            
        Case "SH_EXPORT_TEXTE"
            Call VOIR_REQUETE("TXT", DIALOG)
            
        Case "BTN_VOIR"
            Call VOIR_REQUETE("FRM", DIALOG)
        
        Case "SH_POUBELLE"
            Call SUPPRIMER_QUERY(DIALOG)
            
        Case "SH_BANNIERE"
            MsgBox "Version " & VERSION, vbInformation, APPLI
            
        Case "SH_ACTUALISER"
            Call INVENTORIER(CIBLE, NO_DIALOG)
            
        Case Else
            MsgBox oMsg.GetMessage("M_MSG001"), vbExclamation, APPLI
    End Select
    
    
FIN:
    oSpeed.SpeedMacroOff
    Set oSpeed = Nothing
    Exit Sub

HANDLE_ERROR:
    oSpeed.SpeedMacroOff
    
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    ' Gestion des erreurs - Stack manuel sur l'appel des fonctions
    '*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    MsgBox STACK & vbLf & _
        ERR_ATTENTION_1 & vbLf & _
        ERR_ATTENTION_2 & Err.Number & vbLf & _
        Err.SOURCE & vbLf & _
        Err.Description, vbCritical, APPLI
        
    Resume FIN
End Sub

Private Function ClickDetect() As String
 Static LastHit As Single
 Static Listening As Boolean
 Dim w As Single
 If Not Listening Then
    Listening = True
    w = Timer
    While Timer - w < 0.6
      DoEvents
    Wend
    Listening = False
    If Timer - LastHit > 0.6 Then
      ClickDetect = "Clk"
    Else
      ClickDetect = "Dbl"
    End If
 End If
 LastHit = Timer
End Function

Sub GlobalClick()
Dim mAction As String
mAction = ClickDetect
 
If mAction = "" Then Exit Sub ' un clique mort 

Dim Indice As Long, Btn As Object
Dim Cfg, nName As String
Set Cfg = Range("BtnConfig")
nName = Application.Caller
For I = 1 To Cfg.Rows.Count
    If Cfg(I, 1) = nName Then
       Indice = I
       Exit For
     End If
Next

If Indice = 0 Then
  MsgBox "Nom introuvable " & nName
  Exit Sub
End If

Set Btn = Worksheets("CARTOGRAPHIE").Shapes(nName)
If mAction = "Clk" Then
    'effet visuel
    Const nSec = 1#
    Dim fin, old, x
    old = Btn.Fill.ForeColor.RGB
    Btn.Fill.ForeColor.RGB = Cfg(Indice, 2).Interior.Color
    fin = Now() + nSec / (24# * 60# * 60#)
    Btn.Fill.ForeColor.RGB = &HFF&
    Worksheets("CARTOGRAPHIE").Label1 = Cfg(Indice, 3)
    Sheets("RECUP DONNEES").Range("A2").Value = Cfg(Indice, 4)
    Do: DoEvents: Loop While Now() <= fin
    Btn.Fill.ForeColor.RGB = old
Else ' Dbl doubleClick
    'filtrage ...
    If Cfg(Indice, 6) = "" Then Exit Sub
   
    Dim ws As Worksheet, rng
    Set ws = ThisWorkbook.Sheets("BDD")
     
    If ws.AutoFilterMode Then
       ws.AutoFilterMode = False
    End If
    ' Appliquer le filtre pour ""
    Set rng = ws.Range(Cfg(Indice, 5))
     rng.AutoFilter Field:=rng.Column, Criteria1:=Cfg(Indice, 6)
     ws.Activate
End If

End Sub