XL 2013 Vba Indenter Interface v4.0a

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If

Private TimerID As Variant
Private hWnd As Variant

Sub aa()
    Dim Trusted As Boolean
   
    Trusted = GetVBATrusted
    MsgBox "Avant Trusted = " & Trusted
   
    Call SetVBATrusted(Not Trusted)
   
    Trusted = GetVBATrusted
    MsgBox "Après Trusted = " & Trusted
End Sub

'-------------------------------------------------------------------------------------
'Return True if the "Trust Access to the VBA Project Object Model" checkbox is checked
'-------------------------------------------------------------------------------------
Private Function SetVBATrustedDialog() As Boolean
    Dim Trusted As Boolean
    Dim BN As Integer
   
    'Check access to VBA Project
    Trusted = GetVBATrusted
   
    'Access denied
    If Not Trusted = 0 Then
        'Prompt the User to change the Macros Security
        'BN = MsgBox("The current Macros Security does not allow access to VBA code." & vbCrLf & _
                        "You will be prompted to change this option if you agree to do so." & vbCrLf & vbCrLf & _
                        "To allow access to VBA code, check the checkbox ""Trust Access to the VBA Project Object Model""", _
                        vbOKCancel + vbInformation)
                       
        BN = MsgBox("La sécurité actuelle des macros n'autorise pas l'accès au code VBA." & vbCrLf & _
            "Vous serez invité à modifier cette option si vous acceptez." & vbCrLf & vbCrLf & _
            "Pour autoriser l'accès au code VBA, cochez la case ""Autoriser l'accès au modèle objet du projet VBA""", _
                    vbOKCancel + vbInformation)
                   
        If BN = vbCancel Then Exit Function
       
        Application.CommandBars.ExecuteMso "MacroSecurity"
       
        'Check access to VBA Project
        Trusted = GetVBATrusted
    End If
   
    'Return value
    SetVBATrustedDialog = Trusted
End Function

'------------------------------------------------
'Get Trust Access to the VBA Project Object Model
'------------------------------------------------
Private Function GetVBATrusted() As Boolean
    Dim Version As String
    Dim ErrNumber As Long
   
    On Error Resume Next
    Version = ThisWorkbook.VBProject.VBE.Version
    ErrNumber = Err.Number
    On Error GoTo 0
   
    GetVBATrusted = (ErrNumber = 0)
End Function

'------------------------------------------------
'Set Trust Access to the VBA Project Object Model
'------------------------------------------------
Private Sub SetVBATrusted(Enable As Boolean)
    Dim Trusted As Boolean
    Dim i As Integer
   
    'Check access to VBA Project
    Trusted = GetVBATrusted
   
    If (Trusted And Enable) _
    Or (Not Trusted And Not Enable) Then
        'No change needed
    Else
        hWnd = GetActiveWindow
        TimerID = SetTimer(0, 0, 10, AddressOf TimerProc)
        Application.CommandBars.ExecuteMso "MacroSecurity"
    End If
End Sub

'-----------------------------------------------
'Async SendKeys on the Macro Security Dialog Box
'-----------------------------------------------
Private Sub TimerProc()
    Call KillTimer(0, TimerID)
    Do While GetActiveWindow = hWnd
        DoEvents
    Loop
    CreateObject("wscript.shell").SendKeys "+{TAB}+{TAB}+{TAB}v{ENTER}"
End Sub

'activer l'[accès approuvé au modele d'object du projet vba] par VBA
'patricktoulon
'ici l'exemple est simple
'nous allons lancer en différer une procedure qui va se chager de taper les touche en addressOf avec l'api settimer 
#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" ( _
                              ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
                              ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    
    Private Declare PtrSafe Function KillTimer Lib "user32" ( _
                              ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
    Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
                              ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
    Dim TimerID As LongPtr
    
#Else
    Private Declare Function SetTimer Lib "user32" ( _
                              ByVal hWnd As Long, ByVal nIDEvent As Long, _
                              ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Private Declare Function KillTimer Lib "user32" ( _
                              ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
    
    Private Declare Sub keybd_event Lib "user32" ( _
                              ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Dim TimerID As Long
#End If


' Cette procédure va être appelée automatiquement par le timer
Public Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, _
                     ByVal idEvent As LongPtr, ByVal dwTime As Long)
    Dim Touchest As Byte, i As Byte
    KillTimer 0, TimerID
    touches = Array(&H9, &H9, &H20, &HD)
    For i = 0 To UBound(touches)
        keybd_event touches(i), 0, 0, 0 'apuie
        keybd_event touches(i), 0, &H2, 0 'relache
    Next
    
    'ne pas tester le resultat ici ça declenche l'erreur out of memory  bien connue du settimer
End Sub

Sub AccesVBOM_Timer()
    Dim Test_AccesVBOM, delayx As Long, essais As Long, dem As VbMsgBoxResult
    delayx = 1000
re:
    On Error Resume Next
    Test_AccesVBOM = ThisWorkbook.VBProject.VBComponents(1).Name 'on test l'accès
    
    ' si erreur on lance la procedure d'activation avec le cochage différé
    If Err Then
        Err.Clear
        
        ' Lancer le timer (retard de 300ms ici)
        TimerID = SetTimer(0, 0, delayx, AddressOf TimerProc)
        
        ' Ouvrir la boîte sécurité
        Application.CommandBars.ExecuteMso "MacroSecurity"
        
    Else
        
        MsgBox " ""L'accès approuvé a l'object du modèle de projet vba"" est dèjà activé!!": Exit Sub
        
    End If
    
    'créer un test ici en ajoutant un delay  non bloquant
    Application.Wait Now + 0.00001 'on peut faire un wait bloquant ici on s'en fou puisque de toute facon on a 1 seconde d'attente  avant que la proc active l'accès approuvé
    Test_AccesVBOM = ThisWorkbook.VBProject.VBComponents(1).Name 'on test l'accès
    
    'si err alors
    If Err Then
        ' si essais =0 on peut relancer une fois sur demande
        If essais = 0 Then
            dem = MsgBox("Vba n'a pas pu activé l'accès approuvé a l'object du modèle de projet vba" & vbCrLf & _
                          "Voulez vous faire une autre tentative avec un delay d'une seconde et demiet?", vbYesNo)
            If dem = vbYes Then
                delayx = delayx + 500
                essais = 1
                GoTo re
            End If
        Else
            MsgBox "c'est peine perdue"
        End If
    End If
    
    On Error GoTo 0
End Sub

 CreateObject("wscript.shell").SendKeys "+{TAB}+{TAB}+{TAB}v{ENTER}"
        Application.CommandBars.ExecuteMso "MacroSecurity"

Sub AccessVBOM()
    Dim x As Long
    On Error Resume Next
    x = ThisWorkbook.VBProject.VBE.Version
    If Err.Number = 1004 Then
        CreateObject("wscript.shell").SendKeys "---{TAB}+{TAB}+{TAB}v{ENTER}"
        Application.CommandBars.ExecuteMso "MacroSecurity"
    End If
    On Error GoTo 0
End Sub

Option Explicit

Sub aaa()
    Dim Trusted As Boolean
    
    Trusted = GetVBATrusted
    MsgBox "Avant Trusted = " & Trusted
    
    Call SetVBATrusted(Not Trusted)
    
    Trusted = GetVBATrusted
    MsgBox "Après Trusted = " & Trusted
End Sub


'-------------------------------------------------------------------------------------
'Return True if the "Trust Access to the VBA Project Object Model" checkbox is checked
'-------------------------------------------------------------------------------------
Private Function SetVBATrustedDialog() As Boolean
    Dim Trusted As Boolean
    Dim BN As Integer
    
    'Check access to VBA Project
    Trusted = GetVBATrusted
    
    'Access denied
    If Not Trusted = 0 Then
        'Prompt the User to change the Macros Security
        'BN = MsgBox("The current Macros Security does not allow access to VBA code." & vbCrLf & _
                        "You will be prompted to change this option if you agree to do so." & vbCrLf & vbCrLf & _
                        "To allow access to VBA code, check the checkbox ""Trust Access to the VBA Project Object Model""", _
                        vbOKCancel + vbInformation)
                        
        BN = MsgBox("La sécurité actuelle des macros n'autorise pas l'accès au code VBA." & vbCrLf & _
            "Vous serez invité à modifier cette option si vous acceptez." & vbCrLf & vbCrLf & _
            "Pour autoriser l'accès au code VBA, cochez la case ""Autoriser l'accès au modèle objet du projet VBA""", _
                    vbOKCancel + vbInformation)
                    
        If BN = vbCancel Then Exit Function
        
        Application.CommandBars.ExecuteMso "MacroSecurity"
        
        'Check access to VBA Project
        Trusted = GetVBATrusted
    End If
    
    'Return value
    SetVBATrustedDialog = Trusted
End Function

'------------------------------------------------
'Get Trust Access to the VBA Project Object Model
'------------------------------------------------
Private Function GetVBATrusted() As Boolean
    Dim Version As String
    Dim ErrNumber As Long
    
    On Error Resume Next
    Version = ThisWorkbook.VBProject.VBE.Version
    ErrNumber = Err.Number
    On Error GoTo 0
    
    GetVBATrusted = (ErrNumber = 0)
End Function

'------------------------------------------------
'Set Trust Access to the VBA Project Object Model
'------------------------------------------------
Private Sub SetVBATrusted(Enable As Boolean)
    Dim Trusted As Boolean
    Dim i As Integer
    
    'Check access to VBA Project
    Trusted = GetVBATrusted
    
    If (Trusted And Enable) _
    Or (Not Trusted And Not Enable) Then
        'No change needed
    Else
        CreateObject("wscript.shell").SendKeys String(10, "-") & "+{TAB}+{TAB}+{TAB}v{ENTER}"
        Application.CommandBars.ExecuteMso "MacroSecurity"
    End If
End Sub