[EXCEL-2016] Verrouiller le Projet VBA

Question

Bonsoir @toute l'équipe !

J'ai un classeur avec plusieurs codes VBA. Et mon projet VBA est protéger par un Mot de Passe.

J'y ai rajouté récemment un module permettant d'afficher un MSGBOX personnalisé.

Du coup, à chaque ouverture de fichier, j'ai le message ci-dessous :

J'ai trouvé sur cette page comment déverrouiller le projet:

Sub OterProtectionPRojetVBA()

UnprotectVBProject ActiveWorkbook, "1234"

End Sub

---

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)

Dim vbProj As Object

Set vbProj = WB.VBProject

'Ne peut procéder si le projet est non-protégé.

If vbProj.Protection <> 1 Then Exit Sub

Set Application.VBE.ActiveVBProject = vbProj

'Utilisation de "SendKeys" Pour envoyer le mot de passe.

SendKeys Password & "{TAB}{ENTER}{ENTER}", True

'MsgBox "Après Mot de passe"

Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

End Sub

---

Le code fonctionne bien, seulement, il faut attendre d'avoir fermé et ouvert à nouveau le fichier pour que le Projet se verrouille.

Ma question est la suivante :

=> Est-il possible de verrouiller (bloquer à la lecture) le projet VBA après que le code à l'ouverture du fichier ait fini de s'exécuter ?

D'avance merci pour votre aide précieuse !

Bien cordialement,

Evguen

Answer 1

Oui, mais ton code modifie le projet VBA, ce qui nécessite que le projet soit déverrouillé. Ce n'est pas le cas avec un userform déjà créé dans le projet :

Le userform est créé en faisant un clic droit sur le projet et en cliquant sur "insertion" et "Userform" :

et en ajoutant ensuite les boutons. Je te mets un lien sur un classeur exemple. Le projet est verrouillé avec le mot de passe "toto".

https://mon-partage.fr/f/hAkqevzm/

Daniel

Answer 2

Merci pour cette réponse DanielCo,

=> Est-il, dans ce cas, possible de faire fonctionner le code sans qu'il n'ait besoin de me demander le déverrouillage du projet VBA ?

Evguen

Answer 3

Oui, effectivement, c'est mort, pour autant que je le sache. C'est ce que j'entendais par :

"Est-ce que tu cherches à modifier le code avec une macro ?"

Pour moi, il n'y a pas de solution. Le verrouillage du projet est justement là pour empêcher de modifier le code et, à ma connaissance, le verrouillage-déverrouillage par macro ne fonctionne pas. A mon avis, c'est une sécurité voulue.

Daniel

Answer 4

Bonjour DanielCo,

Le code qui demande le déverrouillage du projet est celui-ci : 

Sub Msgbox_2_Choix_Personnalisés()

Dim vRet As Integer

vRet = MsgBoxPerso(Prompt:="Vous devez faire un choix : ", Buttons:="Intégration|Radiation|Annuler")

If vRet = 1 Then

    Intégration

End If

If vRet = 2 Then

    Radiation

End If

If vRet = 3 Then

    Exit Sub

End If

End Sub

=========================================================================================================

Option Explicit

Option Private Module

' **************************************************************************************

' *                                      ATTENTION!                                    *

' *  <<<<< LE PRESENT MODULE DE CODE EST A INSERER DANS VOTRE PROJET TEL QUEL ! >>>>>  *

' *                                                                                    *

' *   Pour fonctionner, ce module nécessite que l'option "Faire confiance au projet    *

' *         Visual Basic" soit cochée dans le menu Outils / Macro / Sécurité...        *

' **************************************************************************************

'---------------------------------------------------------------------------------------

' Author    : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com

' Date      : 12/12/2008

' Topic     : mDF MsgBoxPerso et boutons personnalisés v1.2

'---------------------------------------------------------------------------------------

' UTILISATION :

' -----------

' Dans votre code, vous ferez appel à la MsgBoxPerso comme vous le faites pour une MsgBox

' "classique", mais avec quelques arguments (optionnels) supplémentaires :

' SYNTAXE de la fonction :

' ----------------------

' R = MsgBoxPerso(Prompt, Title, Icon, Buttons, FontName, FontSize, FontStyle, txtAlign, X, Y)

' ARGUMENTS de la fonction :

' ------------------------

'   * Prompt:    Obligatoire. Il s'agit du texte de votre message.

'   * Title:     Facultatif. Titre de votre message.

'   * Icon:      Facultatif. Représente l'icône que vous voulez voir dans le message.

'                            Valeurs admises : 0 - vNoIcon (par défaut), 1 - vCritical,

'                                              2 - vQuestion, 3 - vExclamation ou

'                                              4 - vInformation.

'   * Buttons:   Facultatif. Chaîne de caractères représentant les libellés des boutons.

'                            Chaque bouton sera séparé par un caractère | (pipe).

'                            Pour définir le bouton qui aura le focus (bouton par défaut),

'                            faites suivre son libellé d'un caractère * (étoile).

'                            Exemple : Oui|Non*|Annuler

'                            ("Non" sera le bouton par défaut)

'   * FontName:  Facultatif. Chaîne de caractères représentant la police à utiliser pour le

'                            message. Exemple : "Arial"

'   * FontSize:  Facultatif. Valeur numérique pour la taille des caractères du message.

'                            Valeurs admises : de 0 à 72.

'   * FontStyle: Facultatif. Représente le style Normal, Gras ou Italic.

'                            Valeurs admises : 0 - vNormal (par défaut), 1 - vBold,

'                                              2 - vItalic ou 3 - vBoldItalic.

'   * TextAlign: Facultatif. Représente l'alignement du texte du message.

'                            Valeurs admises : 0 - vLeft (par défaut), 1 - vCenter ou

'                                              2 - vRight.

'   * X:         Facultatif. Valeur numérique représentant la coordonnée X du coin supérieur

'                            gauche de la boîte de dialogue.

'   * Y:         Facultatif. Valeur numérique représentant la coordonnée Y du coin supérieur

'                            gauche de la boîte de dialogue.

' RETOUR de la fonction :

' ---------------------

' Utilisée en tant que fonction, MsgBoxPerso retourne une valeur de type Integer correspondant

' au numéro d'ordre du bouton cliqué par l'utilisateur.

'

' EXEMPLE :

'

' Dim vRet As Integer

' vRet = MsgBoxPerso("Quel jour de la semaine ?", , , "Lundi|Mardi|Mercredi|Jeudi|Vendredi")

'

' Si l'utilisateur choisit "Jeudi", alors la fonction retournera la valeur 4.

' INFOS COMPLEMENTAIRES :

' ---------------------

' On peut aussi faire l'appel à l'aide des arguments nommés :

'   vRet = MsgBoxPerso(Prompt:="Etes-vous d'accord ?", Buttons:="Oui|Non|Sans avis")

'

' On peut aussi utiliser la macro comme méthode (sans retour de résultat) :

'   MsgBoxPerso "C'est fini !", , , "Ok"

' **************************************************************************************

#If VBA7 Then

'Declare PtrSafe Sub...

    ' Déclaration des fonctions Api Windows pour récupération des Icônes de MsgBox

    Public Declare PtrSafe Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)

    Public Declare PtrSafe Function GetDC& Lib "User32" (ByVal hwnd&)

    Public Declare PtrSafe Function LoadIconA& Lib "User32" (ByVal hInstance&, ByVal lpIconName&)

    Public Declare PtrSafe Function DrawIcon& Lib "User32" (ByVal Hdc&, ByVal X&, ByVal Y&, ByVal hIcon&)

    Public Declare PtrSafe Function DestroyIcon& Lib "User32" (ByVal hIcon&)

#Else

'Declare Sub...

    ' Déclaration des fonctions Api Windows pour récupération des Icônes de MsgBox

    Public Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)

    Public Declare Function GetDC& Lib "User32" (ByVal hwnd&)

    Public Declare Function LoadIconA& Lib "User32" (ByVal hInstance&, ByVal lpIconName&)

    Public Declare Function DrawIcon& Lib "User32" (ByVal Hdc&, ByVal X&, ByVal Y&, ByVal hIcon&)

    Public Declare Function DestroyIcon& Lib "User32" (ByVal hIcon&)

#End If

' Pour les arguments nommés de la fonction

Public Enum StyleIcon

    vNoIcon

    vCritical

    vQuestion

    vExclamation

    vInformation

End Enum

Public Enum TextAlign

    vLeft

    vCenter

    vRight

End Enum

Public Enum StyleFont

    vNormal

    vBold

    vItalic

    vBoldItalic

End Enum

'Variable publique pour "capter" la réponse utilisateur

Public VmsgBoxValue

=========================================================================================================

Function MsgBoxPerso(ByVal Prompt, Optional ByVal Title, Optional ByVal Icon As _

    StyleIcon = vNoIcon, Optional ByVal Buttons = "Ok", Optional ByVal FontName _

    = "Tahoma", Optional ByVal FontSize = 10, Optional ByVal FontStyle As StyleFont _

    = vNormal, Optional ByVal Align As TextAlign = vLeft, Optional ByVal X = 0, _

    Optional ByVal Y = 0) As Integer

Dim Btn

Dim Usf As Object, lblM As Object

Dim Icn As StyleIcon

Dim TestVbp$

Dim LngMaxB%, MargBtn%, Margin%

Dim i As Byte, xBtn As Byte

    'Test si "Faire confiance au projet VB" est coché

    On Error Resume Next

    TestVbp = ThisWorkbook.VBProject.Name

    On Error GoTo 0

    If TestVbp = vbNullString Then

        MsgBox "L'utilisation de la MsgBoxPerso nécessite que l'option" _

            & vbLf & """Faire confiance au projet Visual Basic"" soit cochée" _

            & vbLf & "dans menu Options / Macro / Sécurité...", _

            vbCritical, "mDF MsgBoxPerso..."

        MsgBoxPerso = 0

        Exit Function

    End If

    '

    Btn = Split(Buttons, "|")

    Icn = IIf(Icon < 1, 0, IIf(Icon > 4, 0, Icon + 32512))

    Margin = IIf(Icn > 0, 45, 0)

    FontStyle = Abs(Val(FontStyle))

    If FontStyle > 3 Then FontStyle = 0

    X = Abs(Val(X))

    Y = Abs(Val(Y))

    'Création du USF

    Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)

    'Title

    If IsMissing(Title) Then Title = Application.Name

    Usf.Properties("Caption") = Title

    Usf.Properties("StartUpPosition") = IIf(X + Y = 0, 1, 0)

    'Création zone de Prompt

    Set lblM = Usf.Designer.Controls.Add("Forms.Label.1")

    With lblM

        .Move 0, 15

        .WordWrap = False

        .Font.Size = Application.Min(Abs(Val(FontSize)), 72)

        .Font.Name = CStr(FontName)

        .TextAlign = IIf(Align < 0, 1, IIf(Align > 2, 1, Align + 1))

        .Font.Bold = FontStyle Mod 2 <> 0

        .Font.Italic = FontStyle > 1

        .AutoSize = True

        .Caption = Prompt

        .AutoSize = False

    End With

    'Création Buttons

    xBtn = 1    'Focus sur le premier bouton par défaut

    For i = 0 To UBound(Btn)

        With Usf.Designer.Controls.Add("Forms.CommandButton.1")

            .AutoSize = True

            .Caption = Application.Substitute(Btn(i), "*", "")

            LngMaxB = Application.Max(LngMaxB, .Width)

            .AutoSize = False

            'On mémorise le bouton désigné par défaut (terminé par *)

            If Right(Btn(i), 1) = "*" Then xBtn = i + 1

        End With

    Next i

    LngMaxB = Application.Max(LngMaxB, 50)

    'Placement des contrôles sur le USF et insertion du code VBA évènementiel

    With lblM

        Usf.Properties("Width") = Application.Max((LngMaxB + 10) * _

            (UBound(Btn) + 1) + 5, .Width + 24)

        Usf.Properties("Height") = 85 + .Height

        .Move Margin + 10, 15, Usf.Properties("Width") - 24, .Height

    End With

    With Usf

        MargBtn = (.Properties("Width") - (LngMaxB + 5) * (UBound(Btn) + 1)) \ 2

        'Procédure UserForm_Activate()

        With .CodeModule

            .InsertLines .CountOfLines + 1, "Private Sub UserForm_Activate(): " _

                & "Dim hwnd&, hIcon&: DoEvents:" _

                & "hwnd = FindWindowA(vbNullString, Me.Caption):" _

                & "hIcon = LoadIconA(0&," & Icn & "):" _

                & "DrawIcon GetDC(hwnd), 26, 24, hIcon:" _

                & "DestroyIcon hIcon: Me.Controls(""CommandButton" & xBtn & """)" _

                & ".Setfocus:Beep:End Sub"

        End With

        For i = 0 To UBound(Btn)

            .Designer.Controls("CommandButton" & i + 1).Move Margin + MargBtn + _

                (LngMaxB + 5) * i, lblM.Top + lblM.Height + 22, LngMaxB, 20

            'Procédures évènementielles liées aux Buttons

            With .CodeModule

                .InsertLines .CountOfLines + 1, "Sub CommandButton" & i + 1 _

                    & "_Click():VmsgBoxValue =" & i + 1 & " :Unload Me:End Sub"

            End With

        Next i

        Usf.Properties("Width") = Usf.Properties("Width") + Margin

        'Interdire fermeture par la croix

        With Usf.CodeModule

            .InsertLines .CountOfLines + 1, "Private Sub UserForm_QueryClose(Cancel " _

                & "As Integer, CloseMode As Integer):Cancel = CloseMode = 0:End Sub"

        End With

        'Affichage la MsgBoxPerso, puis auto-destruction du USF

        If X + Y > 0 Then

            Usf.Properties("Left") = X

            Usf.Properties("top") = Y

        End If

        VBA.UserForms.Add(.Name).Show

    End With

    ThisWorkbook.VBProject.VBComponents.Remove Usf

    MsgBoxPerso = VmsgBoxValue

End Function

Ce que je souhaite, est de pouvoir maintenir le verrouillage (de la lecture) du projet, et permettre à ce code de s'exécuter normalement.

Merci pour l'intérêt que tu portes à mon problème.

Excellente journée,

Evguen

Answer 5

Bonjour,

A ma connaissance, non, malheureusement. Quel est le code qui demande le déverrouillage du projet ? Est-ce que tu cherches à modifier le code avec une macro ?

Cordialement.

Daniel