XL 2021 Exportation module, erreur après déprotection

Nicolas JACQUIN · 19 Juin 2024

Bonjour à tous,

Toujours sur mon petit projet,
Aujourd'hui encore un souci, j'ai créé un bouton pour exporter les modules d'un fichier, mais quand je déprotège ça marche plus.
Je me suis permit de vous faire une petite vidéo (c'est ma première ), par ce que à l'écrit c'est pas évident pour moi de me faire comprendre.

Voici quelque partie de code en plus de ma première .

VB:

Private Sub Bt1_Click()
    Dim Reponse
    If Hook = False Then
        MsgBox "L'interface VBA est déjà débloquée", , "VBA"
        Expor.Visible = True
    End If
    Lbt1.BackColor = vbGreen
    Bbt1.Caption = "Débloqué"
    Expor.Visible = True
End Sub

Private Sub Expor_Click()
    Dim FileNum As Integer
    Dim LineCount As Long
    Dim LineText As String
    Dim FileName As String
    Dim Reponse
    Reponse = MsgBox("Souhaitez vous exporter le projet ?", vbYesNo, "Choix d'exportation")
    If Reponse = vbNo Then
        Exit Sub
    ElseIf Reponse = vbYes Then
        ' Définir le dossier d'exportation
        ExportFolder = ActiveWorkbook.Path & "\ExportedModules" & " " & ActiveWorkbook.Name & "\"

            ' Créer le dossier d'exportation s'il n'existe pas
            If Dir(ExportFolder, vbDirectory) = "" Then
                MkDir ExportFolder
            End If

            ' Parcourir tous les composants du projet VBA
            For Each VBComp In ActiveWorkbook.VBProject.VBComponents
                ' Ignorer les composants sans code (comme les modules de classe vierges)
                If VBComp.CodeModule.CountOfLines <> 0 Then
                    FileName = ExportFolder & VBComp.Name & ".txt"
                    FileNum = FreeFile

                    ' Ouvrir le fichier en écriture
                    Open FileName For Output As FileNum

                    ' Obtenir le module de code
                    Set CodeMod = VBComp.CodeModule

                    ' Exporter chaque ligne de code
                    For LineCount = 1 To CodeMod.CountOfLines
                        LineText = CodeMod.Lines(LineCount, 1)
                        Print #FileNum, LineText
                    Next LineCount

                    ' Fermer le fichier
                    Close FileNum
                End If
            Next VBComp
        Else
            MsgBox "Une erreur est survenue"
            Exit Sub
        End If
    
    MsgBox "Exportation terminée!", vbInformation

    Expor.Visible = False
End Sub

Code:

Private Sub UserForm_Initialize()
    Dim fc As Worksheet, wb As Workbook, ws As Worksheet, nb As Long, VPC As Object, vbProj As Object

    If Not Me.Visible Then OteTitleBarre Me.Caption, False

    Me.StartUpPosition = 0: Me.Top = 0: Me.Left = 0
    sep1.Height = 1: sep2.Height = 1: version = vers
    Textinfo.Visible = False
    Expor.Visible = False

    Set wb = ActiveWorkbook
    Set vbProj = wb.VBProject
    If vbProj.Protection = 1 Then
        'MsgBox "VBAProject est protégé"
        Lbt1.BackColor = vbRed
        Bbt1.Caption = "Bloqué"
        'Expor.Visible = False
    Else
        'MsgBox "VBAProject non protégé"
        Lbt1.BackColor = vbGreen
        Bbt1.Caption = "Débloqué"
        'Expor.Visible = True
    End If

Aperçu du prog

et ma première pour vous aidez à mieux comprendre

Dranreb · 22 Juin 2024

Bonjour

Nicolas JACQUIN à dit:
Et pour ce poste là, je ne sais pas ce que tu as voulu essayé, j'ai pas eu de nouvelles à part tes suggestions

Moi je n'ai rien proposé concernant votre classeur car il n'a toujours pas été joint de sorte que je ne peux pas trouver ce qui ne va pas. J'ai juste vu dans vos bouts de codes des variables locales qui auraient assurément mérité d'être globales, en Private, au moins le WorkBook traité.

Nicolas JACQUIN · 23 Juin 2024

Bonjour à tous,
Je vous rejoint les bouts de code en essayant d'êtres assez compréhenssif.

Sur cette partie là, ça fonctionne (peut-être à améliorer mais bon)

VB:

Private Sub UserForm_Initialize()
    Dim fc As Worksheet, wb As Workbook, ws As Worksheet, nb As Long, VPC As Object, vbProj As Object
    Set Wbk = ActiveWorkbook

    If Not Me.Visible Then OteTitleBarre Me.Caption, False

    Me.StartUpPosition = 0: Me.Top = 0: Me.Left = 0
    sep1.Height = 1: sep2.Height = 1: version = vers
    Textinfo.Visible = False

    Set vbProj = Wbk.VBProject
    If vbProj.Protection = 1 Then
        'MsgBox "VBAProject est protégé"
        Lbt1.BackColor = vbRed
        Bbt1.Caption = "Bloqué"
        Expor.Visible = False
    Else
        'MsgBox "VBAProject non protégé"
        Lbt1.BackColor = vbGreen
        Bbt1.Caption = "Débloqué"
    End If

    nb = 0
    For Each ws In Wbk.Worksheets
        If ws.Visible = False Then nb = nb + 1
    Next ws
    If nb >= 1 Then
        Lbt2.BackColor = vbRed
        Label2.Caption = IIf(nb >= 2, "Feuilles invisibles", "Feuille invisible")
        Bbt2.Caption = "(" & nb & ")"
    Else
        Label2.Caption = "Toutes les feuilles visibles"
        Lbt2.BackColor = vbGreen
        Bbt2.Caption = "Ok"
    End If

    nb = 0
    For Each ws In Wbk.Worksheets
        If ws.ProtectContents Then
            nb = nb + 1
        End If
    Next ws
    If nb >= 1 Then
        Lbt3.BackColor = vbRed
        Label3.Caption = IIf(nb >= 2, "Feuilles protégées", "Feuille protégée")
        Bbt3.Caption = "(" & nb & ")"
    Else
        Label3.Caption = "Toutes les feuilles déprotégées"
        Lbt3.BackColor = vbGreen
        Bbt3.Caption = "Ok"
    End If

    For Each fc In Worksheets

        If ActiveWindow.DisplayGridlines = False Then
            Lbt4.BackColor = vbRed
            Bbt4.Caption = "Off"
        Else
            Lbt4.BackColor = vbGreen
            Bbt4.Caption = "On"
        End If

        If Application.DisplayStatusBar = False Then
            Lbt5.BackColor = vbRed
            Bbt5.Caption = "Off"
        Else
            Lbt5.BackColor = vbGreen
            Bbt5.Caption = "On"
        End If

        If Application.DisplayFormulaBar = False Then
            Lbt6.BackColor = vbRed
            Bbt6.Caption = "Off"
        Else
            Lbt6.BackColor = vbGreen
            Bbt6.Caption = "On"
        End If

        If ActiveWindow.DisplayHeadings = False Then
            Lbt7.BackColor = vbRed
            Bbt7.Caption = "Off"
        Else
            Lbt7.BackColor = vbGreen
            Bbt7.Caption = "On"
        End If

        If ActiveWindow.DisplayHorizontalScrollBar = False Then
            Lbt8.BackColor = vbRed
            Bbt8.Caption = "Off"
        Else
            Lbt8.BackColor = vbGreen
            Bbt8.Caption = "On"
        End If

        If ActiveWindow.DisplayVerticalScrollBar = False Then
            Lbt9.BackColor = vbRed
            Bbt9.Caption = "Off"
        Else
            Lbt9.BackColor = vbGreen
            Bbt9.Caption = "On"
        End If

        If Application.CommandBars.Item("Ribbon").Height > 100 Then
            Lbt10.BackColor = vbGreen
            Bbt10.Caption = "On"
        Else
            Lbt10.BackColor = vbRed
            Bbt10.Caption = "Off"
        End If

    Next fc

    If colonne >= 1 Then
        Lbt11.BackColor = vbRed
        Label18.Caption = IIf(colonne >= 2, "Colonnes masquées", "Colonne masquée")
        Bbt11.Caption = "(" & colonne & ")"
    Else
        Label18.Caption = "Toutes les colonnes visibles"
        Lbt11.BackColor = vbGreen
        Bbt11.Caption = "Ok"
    End If

    If ligne >= 1 Then
        Lbt12.BackColor = vbRed
        Label17.Caption = IIf(colonne >= 2, "Lignes masquées", "Ligne masquée")
        Bbt12.Caption = "(" & ligne & ")"
    Else
        Label17.Caption = "Toutes les lignes visibles"
        Lbt12.BackColor = vbGreen
        Bbt12.Caption = "Ok"
    End If

End Sub

Sur cette partie là aussi tout fonctionne bien

Code:

Private Wbk As Workbook

Private Sub Bt1_Click() 'bouton déblocage vbe
    If Lbt1.BackColor = vbRed Then
        If Hook Then
        MsgBox "L'interface VBA est débloquée", , "VBA"
        End If
        Expor.Visible = True 'bouton exportation module
        Lbt1.BackColor = vbGreen
        Bbt1.Caption = "Débloqué"
        Expor.Visible = True
    ElseIf Lbt1.BackColor = vbGreen Then
        MsgBox "L'interface VBA est déjà débloquée", , "VBA"
    End If
End Sub

C'est juste sur cette partie là que ça veux pas, si j'ouvre l'éditeur vba et que je le referme tout symplement, ça fonctionne très bien, mais le but est de pouvoir le faire directement depuis mon interface (complément) sinon ça ne sert à rien.

Code:

Private Sub Expor_Click() 'bouton exportation module
    Dim FileName$, Reponse As VbMsgBoxResult, ExportFolder$, Vbcomp As VBComponent

    Set Wbk = ActiveWorkbook
    Reponse = MsgBox("Souhaitez vous exporter le projet ?", vbYesNo, "Choix d'exportation")

    If Reponse = vbNo Then Exit Sub
    On Error GoTo Err1
    ' Définir le dossier d'exportation
    ExportFolder = Wbk.Path & "\ExportedModules" & " " & Wbk.Name & "\"

    ' Créer le dossier d'exportation s'il n'existe pas
    If Dir(ExportFolder, vbDirectory) = "" Then MkDir ExportFolder

    ' Parcourir tous les composants du projet VBA
    For Each Vbcomp In Wbk.VBProject.VBComponents
        ' Ignorer les composants sans code (comme les modules de classe vierges)
        If Vbcomp.CodeModule.CountOfLines > 0 Then
            FileName = ExportFolder & Vbcomp.Name & ".txt"
            Vbcomp.Export FileName
        End If
    Next Vbcomp

    MsgBox "Exportation terminée!", vbInformation
    Exit Sub

Err1:
    MsgBox "Une erreur est survenue, voulez vous réessayer ?", , "Erreur"
    Expor_Click
End Sub

Sinon il me reste plus cas tout mettre à la poubelle
Merci
Nicolas

Dranreb · 23 Juin 2024

Pourquoi réinitialez vous Wbk alors que c'est une variable globale qui a déjà été initialisée au UserForm_Initialize ? Ça la détruit si le classeur à traiter n'est plus actif !

Nicolas JACQUIN · 23 Juin 2024

J'ai bien pris en compte les conseils mais sans succès.
Pour ce qui est du dévérouillage vbe (l'exportation des modules) j'ai essayé avec

VB:

Application.VBE.MainWindow.Visible = True
Application.VBE.MainWindow.Visible = false

Mais ça match pas mieux.
Je ne sais plus
Nicolas

patricktoulon · 23 Juin 2024

re
Bonjour Nicolas
je te l'ai déjà dit pourquoi
comment te le dire dans un francais que tu va enfin comprendre?
ton hook ne casse pas la protection du vbproject !!!!
il te permet simplement de passer par dessus en occultant le dialog password du vbproject
en le renvoyant dans une autre address mémoire
mais cela fonctionne en mode VBE

donc quand tu lance ton hook; oui en effet tu peux explorer les modules vba dans VBE
mais!! ton vbproject est toujours protégé!!!!

Dranreb · 23 Juin 2024

Alors c'est là qu'il faudrait peut être exécuter mon :

VB:

If VPt.Protection = 1 Then
      Set Application.VBE.ActiveVBProject = VPt
      SendKeys PsW & "~~"
      Application.VBE.CommandBars(1).FindControl(Id:=2578, Recursive:=True).Execute
      DoEvents: End If

Avec VPt une variable As VBIDE.VBProject convenablement initialisée au projet à traiter,
PsW une expression String reprenant le mot de passe trouvé de cet autre emplacement …

XL 2021 Exportation module, erreur après déprotection

Nicolas JACQUIN

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Discussions similaires