Macro qui fait l’inverse de ce que je veux ^^

Imy55

XLDnaute Nouveau

Bonsoir tout le monde,
J’ai la macro suivante qui doit normalement enregistrer mon fichier d’origine Mevaling11.xlsm avec un nouveau nom (de la cellule H6 la feuil32) et sans le « Module11 » sans le code du « Thisworkbook » et sans la form « Frmaccueil ».
Mais au lieu qu’elle supprime ces derniers du nouveau fichier elle le supprime de l’originale « Mevaling11 »
Code:
Option Explicit
Sub enregistrer_classeur() 'adapter les strings en conséquences
Dim x As Long 'déclare la variable x
Dim a As Variant 'déclare la variable a
Dim VBComp As Variant
Dim chemin As String, fichier As String
'définit la varaible x (nombre de lignes du code VBA)
x = ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.CountOfLines
With ThisWorkbook
    chemin = .Path & "\Etudes\"
    fichier = chemin & Feuil32.Range("H6") & ".xlsm"
    .SaveCopyAs fichier
End With
If ThisWorkbook.Name = "Mevaling11.xlsm" Then Exit Sub 'à adapter à ton fichier
Set a = ActiveWorkbook.VBProject.VBComponents("Module11")
'supprime les lignes de code VBA dans la copie de sauvegarde
ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.DeleteLines 1, x
ActiveWorkbook.VBProject.VBComponents.Remove (a)
Set VBComp = ThisWorkbook.VBProject.VBComponents("Frmaccueil")
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub
J’appelle la Macro avec un bouton enregistrer :
Code:
Private Sub CommandButton5_Click()
Call enregistrer_classeur
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Macro qui fait l’inverse de ce que je veux ^^

Bonjour,

(Est ce que je peux ouvrir une nouvelle discussion?
il est tyoujours préférable de rester sur le même fil pour un même sujet.... cela évite de se disperser....

un aute essai ci-dessous, code qui supprime tous les codes et modules dans le classeur où est exécutée cette procédure... A noter "thisworkbook", peut être remplacer par le classeur actif ou tout autre classeur de la collection "workbooks"...

Code:
Option Explicit
Sub test()
Dim v As Object
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type < 4 Then
            .VBComponents.Remove v
        Else
            With v.codemodule
                .DeleteLines 1, .CountOfLines
            End With
        End If
    Next v
End With
End Sub

code opérationnel chez moi sous excel 2003...

bonne journée
@+
 

Discussions similaires

Réponses
2
Affichages
743

Membres actuellement en ligne

Statistiques des forums

Discussions
312 493
Messages
2 088 957
Membres
103 990
dernier inscrit
lamiadebz