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

[Nicolas JACQUIN]

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 .

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

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

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

 

[Dranreb]

Bonjour.
On ne peut pas consulter ni exporter un projet VBA protégé. Je suppose que c'est quand vous le protégez, intentionnellement ou non, que ça ne passe plus.
Mais je ne suis pas sûr que la propriété Protection soit en lecture/écriture.
Remarque: un VBComponent est muni d'une méthode Export pour l'écrire en une seule instruction dans un fichier.
Dans ce code j'exporte 3 modules de service en déprotégeant préalablement le projet s'il y a lieu :

Public Sub ExportModules()
   Dim ChNomF, TNomFic(), P As Long
   If CurDir <> Application.UserLibraryPath Then
      Select Case MsgBox("Vous avez demandé à exporter les 3 modules de service." _
         & vbLf & "Les souhaiteriez vous dans votre dossier de compléments ?", _
         vbYesNoCancel + vbQuestion, "Export modules")
         Case vbYes: ChDrive Application.UserLibraryPath: ChDir Application.UserLibraryPath
         Case vbCancel: Exit Sub: End Select: End If
   ChNomF = Application.GetSaveAsFilename("MGigogne", "Module standard,*.Bas")
   If VarType(ChNomF) <> vbString Then Exit Sub
   TNomFic = Array("MGigogne.Bas", "SsGr.Cls", "MTableaux.Bas")
   On Error Resume Next
   If ThisWorkbook.VBProject.Protection = 1 Then
      Set Application.VBE.ActiveVBProject = ThisWorkbook.VBProject
      SendKeys "Dranreb~~": Application.VBE.CommandBars(1).FindControl(Id:=2578, Recursive:=True).Execute
      DoEvents: End If
   Err.Clear
   For P = 0 To UBound(TNomFic)
      ThisWorkbook.VBProject.VBComponents(Split(TNomFic(P), ".")(0)).Export TNomFic(P)
      If Err Then MsgBox "Erreur " & Err & " en tentant d'exporter """ & TNomFic(P) & """." _
         & vbLf & Err.Description, vbCritical, "Export modules": Exit Sub
      Next P
   If MsgBox("Exportations effectuées." & vbLf & "Voulez vous les importer dans un nouveau classeur ?", _
      vbYesNo + vbInformation, "Export modules") = vbNo Then Exit Sub
   Workbooks.Add
   For P = 0 To UBound(TNomFic)
      ActiveWorkbook.VBProject.VBComponents.Import TNomFic(P)
      If Err Then MsgBox "Erreur " & Err & " en tentant d'importer """ & TNomFic(P) & """." _
         & vbLf & Err.Description, vbCritical, "Export modules": Exit Sub
      Next P
   If MsgBox("Importations effectuées." & vbLf & "Voulez vous conserver ces fichiers ?", _
      vbYesNo + vbInformation, "Export modules") = vbYes Then Exit Sub
   For P = 0 To UBound(TNomFic): Kill TNomFic(P): Next P
   End Sub

 

[Nicolas JACQUIN]

Boujour Dranreb,
Je viens de me relire et encore mal exposé mon projet, heureusement que j'ai fait une petite vidéo (avec le son).
Mon programme est censé (censé tout debloqué), ça marche.
Pour exporter les modules vbe d'un projet déprotégé quand je l'ouvre, il n'y a pas de soucis.
Le soucis c'est quand j'ouvre un fichier qui est protégé (vba), quand je clic sur le bouton ça marche bien, mais apparemment une fois dévérouillé je suis obligé de fermé et réouvrir mon programme pour pouvoir faire l'exportation des modules.
Merci

 

[Dranreb]

Avez-vous le même problème avec mon code ?

 

[Nicolas JACQUIN]

Je vais essayer pour voir

 

[Nicolas JACQUIN]

re, je ne sais pas comment adapter à mon code actuel

 

[Dranreb]

Au lieu de ThisWorkBook mettez une variable Workbook représentant le classeur dont vous voulez exporter les module, et construisez la table TNomFic d'après les modules qui y figurent. Le reste ne devrait guère changer, à part le mot de passe ("Dranreb" dans mon cas) s'il y a lieu de déprotéger le projet pour permettre l'exportation.

 

[patricktoulon]

re
Bonsoir Nicolas envoie moi ton fichier je vais essayez de lui faire quelque chose

 

[patricktoulon]

re
déja pour commencer

ensuite quelle idée de le faire avec open for exporte tout simplement même si tu met l'extension txt

 

[Nicolas JACQUIN]

Je l'ai trouvé sur ChatGPT

 

[patricktoulon]

oui mais le 3.5 te donne 3 ou 4 réponses avant de te donner la bonne

Private Sub Expor_Click()
   'patricktoulon
   Dim   FileName$, Reponse As VbMsgBoxResult, ExportFolder$,Vbcomp as vbcomponent
    Reponse = MsgBox("Souhaitez vous exporter le projet ?", vbYesNo, "Choix d'exportation")
  
    If Reponse = vbNo Then Exit Sub
      
   ' 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
 
    ' 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"
           vbcomp.Export FileName
        End If
    Next vbcomp
  
    MsgBox "Exportation terminée!", vbInformation
  
Expor.Visible = False
End Sub

 

[patricktoulon]

re
1°tu utilise activeworkbook hors quand tu clique sur un bouton du userform c'est le craker lui même qui devient l'actif

2°tu utilise un hook pour shunter le dialog du password donc tu ne déprotège pas vraiment tu passe par dessus c'est tout conclusion 1 coup sur deux ben ça bloque

3°perso je tenterais l'export et si msgbox d'erreur alors là oui proposition du hook et je vire ce bouton en haut

4° d'autant plus que le control hook doit se faire a l'initialise ok mais aussi au bouton parcourir chose qui a été complétement occultée

5° j'ajouterais que décider de la destination(dossier d'export) avec le active workbook va certainement entrainer des dossier disséminés un peu partout
donc à moindre mal proposer un dialog folder

6°tu semble avoir perdu de vue que c'est un complément que tu veux faire
ce qui implique des méthodes et une reconsidération des variables object dans leur contexte

conclusion : c'est au niveau conceptuel que ça ne va pas certainement du a une méconnaissance du contexte du hook

 

[Nicolas JACQUIN]

Bonjour Patrick, je verrai tout ça en rentrant ce soir, merci

 

[Nicolas JACQUIN]

2°tu utilise un hook pour shunter le dialog du password donc tu ne déprotège pas vraiment tu passe par dessus c'est tout conclusion 1 coup sur deux ben ça bloque

Bonjour Patrick,
le hook fonctionne (a peu près) je pense, le seul soucis que j'ai, c'est que je débloque (ça match) mais je suis obligé de fermer l'userform, ouvrir l'éditeur vba et le refermer tout simplement, après je réouvre l'userform et l'exportation fonctionne super bien. J'ai essayé de 50000 façons mais pas moyen.
Merci

 

[Nicolas JACQUIN]

4° d'autant plus que le control hook doit se faire a l'initialise ok mais aussi au bouton parcourir chose qui a été complétement occultée

re, C'est pas un oubli, j'y ai pensé mais si mon but initiale est pas résolu ça ne sert à rien que j'ailles plus loin.

J'ai bien pris tout tes points en compte, comme le dernier, mais je pense avoir compris c'est du Boolean donc false ou true. Après je sais que je suis loin, très loin de tout connaitre mais j''essais.

Bonsoir Nicolas envoie moi ton fichier je vais essayez de lui faire quelque chose

Et pour ce poste là, je ne sais pas ce que tu as voulu essayé, j'ai pas eu de nouvelles à part tes suggestions.
Je pense que tu as les réponses à mes petits soucis, mais je buches en attendant. 😩

Merci