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

[Imy55]

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 »

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 :

Private Sub CommandButton5_Click()
Call enregistrer_classeur
End Sub

 

[KenDev]

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

Bonsoir Imy,

Une proposition :

Option Explicit

Sub enregistrer_classeur_bis(NomFichier As String)
Dim VbP As Object, VbC As Object, v As Object
'enregistre une copie identique selon le paramètre de la procédure CommandButton5_Click()
ThisWorkbook.SaveCopyAs NomFichier
'ouvrir la copie
Workbooks.Open (NomFichier)
'déclaration d'objets
Set VbP = ActiveWorkbook.VBProject
Set VbC = VbP.VBComponents
'boucler sur tous les components
For Each v In VbC
    'selon le nom du component
    Select Case v.Name
        Case "Module11", "Frmaccueil"
            'suppression du module
            VbC.Remove v
        Case "ThisWorkbook"
            'suppression des lignes du modules
            v.CodeModule.DeleteLines 1, v.CodeModule.CountOfLines
    End Select
Next v
'sauver et fermer la copie
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

La procédure associée au bouton :

Private Sub CommandButton5_Click()
Call enregistrer_classeur_bis(ThisWorkbook.Path & "\Etudes\" & Worksheets("Feuil32").Range("H6") & ".xlsm")
End Sub

Il est supposé que :
_le bouton déclancheur est dans le classeur d'origine
_que le sous dossier (par rapport au dossier du classeur d'origine) "Etudes" existe
Un éventuel classeur homonyme préexistant dans "Etudes" sera écrasé

Cordialement

KD

 

[Imy55]

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

Bonsoir KenDev pour ta réponse et pour ta disponibilité,
En fait j’ai remplacé ma Maro par la tienne mais j’ai l’erreur (L’indice n’appartient pas à la sélection) dans la ligne :

Call enregistrer_classeur_bis(ThisWorkbook.Path & "\Etudes\" & Worksheets("Feuil32").Range("H6") & ".xlsm")

 

[KenDev]

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

Bonsoir Imy,

Oui il faut l'adapter un petit peu, tu n'as plus de Feuil32 dans le classeur que tu fournis...
Tu dois remplacer "Feuil32" par le nom de la feuille ou se trouvera la cellule qui définira le nom du nouveau classeur.

Je prévois des problèmes futurs :
_ Dans tes exemples tu disais vouloir supprimer l'Userform ""Frmaccueil", or il n'y a qu'un Userform "Frmpermanant"maintenant.
_ Le nom du nouveau classeur estcensé être en H6 or sur toutes les feuilles la cellule H6 est vide... Si la cellule a été déplacée il faudra modifier ce point aussi.

Une remarque : ton fichier ne contient (au niveau vba) qu'un module, un userform et du code dans le module ThisWorkbook. Ton but n'est t-il pas simplement d'enregistrer une copie sans vba ? Auquel cas plutôt que de supprimer des éléments bien précis autant tout enregistrer au format xlsx ?

Cordialement

KD

 

[Imy55]

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

Merci kenDev,
Oui c’est vrai que j’ai modifié l’application pour diminuer sa taille et je n’est pas pensé de notifier les changements vu ma fatigue ^^. (La cellule H6 je la remplie à chaque utilisation )
Je vais ressayer demain.
Merci encore une fois.

 

[Imy55]

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

Ton code travail nickel,
J’avais une confusion entre le non de la feuille (le nom dans le VBA ou bien le nom du classeur) c’était tout simplement celui du classeur c.à.d. « entreprise » hihi .
Donc mon nouveau code est (je veux dire ton nouveau code^^):

Option Explicit

Sub enregistrer_classeur_bis(NomFichier As String)
Dim VbP As Object, VbC As Object, v As Object
'enregistre une copie identique selon le paramètre de la procédure CommandButton5_Click()
ThisWorkbook.SaveCopyAs NomFichier
'ouvrir la copie
Workbooks.Open (NomFichier)
'déclaration d'objets
Set VbP = ActiveWorkbook.VBProject
Set VbC = VbP.VBComponents
'boucler sur tous les components
For Each v In VbC
    'selon le nom du component
   Select Case v.Name
        Case "Module11", "Frmaccueil"
            'suppression du module
           VbC.Remove v
        Case "ThisWorkbook"
            'suppression des lignes du modules
           v.CodeModule.DeleteLines 1, v.CodeModule.CountOfLines
    End Select
Next v
'sauver et fermer la copie

Merci pour ton aide KenDev

 

[Imy55]

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

Toujours il y a des surprises avec les codes et les macro,
J’ai adapté le code à mon application complète. Il faut supprimer plusieurs Userform.
Mais lors de l’exécution de la Macro, le fichier enregistrer avec le nouveau nom s’ouvre avec ses macro et ses Userform. Lorsque je fais la dernière étape pour entrer au classeur (je passe par plusieurs Userform avant d’arriver à l’Userform modale qui s’affiche avec la feuille entreprise) c’est juste là que l’opération s’interrompe et il s’enregistre définitivement et il se ferme automatiquement.
L’application a une grande taille et j’arrive pas à l’envoyer, Si cela pose problème je peux vous faire une explication détaillée.

Option Explicit
Sub enregistrer_classeur_bis(NomFichier As String)
Dim VbP As Object, VbC As Object, v As Object
'enregistre une copie identique selon le paramètre de la procédure CommandButton5_Click()
ThisWorkbook.SaveCopyAs NomFichier
'ouvrir la copie
Workbooks.Open (NomFichier)
'déclaration d'objets
Set VbP = ActiveWorkbook.VBProject
Set VbC = VbP.VBComponents
'boucler sur tous les components
For Each v In VbC
    'selon le nom du component
   Select Case v.Name
        Case "ThisWorkbook"
            'suppression des lignes du modules
           v.CodeModule.DeleteLines 1, v.CodeModule.CountOfLines
        Case "Module11", "Frmprogression", "Frmaccueil", "Frmapropos", "Frmentreprise", "Frmpermanant"
            'suppression du module
           VbC.Remove v
        
    End Select
Next v
'sauver et fermer la copie
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Je trouve ça birrare parce que la macro fonctionne dans l’exemple de l’application où il y a juste un seul Userform et elle ne fonctionne pas dans la version originale

 

[Pierrot93]

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

Bonjour,

pas tout suivi, mais ci-dessous code pour supprimer tous les usf d'un claseur, à placer dans un module standard...

Option Explicit
Sub test()
Dim v As Object
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With
End Sub

bon après midi
@+

 

[Imy55]

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

Bonjour,

pas tout suivi, mais ci-dessous code pour supprimer tous les usf d'un claseur, à placer dans un module standard...

Option Explicit
Sub test()
Dim v As Object
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With
End Sub

bon après midi
@+

Merci Pierrot93 pour la réponse mais j'arrive toujours pas à supprimer les Userform. Je sens que la réponse est sous mes yeux et je n'arrive pas à la detecter.
Ton code m'a suupprimé les Userform de la verssion originale il faut que je refait tout

 

[Pierrot93]

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

Re,

Merci Pierrot93 pour la réponse mais j'arrive toujours pas à supprimer les Userform. Je sens que la réponse est sous mes yeux et je n'arrive pas à la detecter.
Ton code m'a suupprimé les Userform de la verssion originale il faut que je refait tout

Aarf, avais prévenu :

pas tout suivi, mais ci-dessous code pour supprimer tous les usf d'un claseur

j'epère que tu n'as pas enregistrer.... il faut exécuter ce code sur une copie de ton classeur...

 

[Imy55]

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

Re,



Aarf, avais prévenu :

j'epère que tu n'as pas enregistrer.... il faut exécuter ce code sur une copie de ton classeur...

Euf Heuresement j'ai trouvé une copie enregistrée ^^
Stp Pierrot si t'as une idée pour supprimer les Userforms du fichier enregistré et non pas de l'original aidez moi. celà fait des semaine que je cherche la solution et quand j'ai réussi à faire Une partie de ma macro ja l'avais publié KD m'a donné hier beaucoup d'aide j'avais cru que la macro va marché sur mon application avec plusieur US mais j'avais tort.

 

[Pierrot93]

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

Re,

enregistre une copie de ton fichier au préalable...

Dim v As Object
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\MonClasseur.xls"
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With

 

[Pierrot93]

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

Re,

tu peux également faire un "saveas" en fin de procédure, ce qui n'affectera pas le classeur original...

Dim v As Object
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With
ThisWorkbook.SaveAs ThisWorkbook.Path & "\MonClasseur.xls"

 

[Imy55]

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

Ces Macro sans têtues;
Lien vers l'application: MEGAUPLOAD - The leading online storage and file delivery service

Option Explicit
Sub enregistrer_classeur_bis(NomFichier As String)
Dim VbP As Object, VbC As Object, v As Object
'enregistre une copie identique selon le paramètre de la procédure CommandButton5_Click()
ThisWorkbook.SaveCopyAs NomFichier
'ouvrir la copie
Workbooks.Open (NomFichier)
'déclaration d'objets
Set VbP = ActiveWorkbook.VBProject
Set VbC = VbP.VBComponents
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Mevaling11.xlsm"
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With
'boucler sur tous les components
For Each v In VbC
    'selon le nom du component
   Select Case v.Name
        Case "ThisWorkbook"
            'suppression des lignes du modules
           v.CodeModule.DeleteLines 1, v.CodeModule.CountOfLines
        Case "Module11", "Frmprogression", "Frmaccueil", "Frmapropos", "Frmentreprise", "Frmpermanant"
            'suppression du module
           VbC.Remove v
       
    End Select
Next v
'sauver et fermer la copie
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[tototiti2008]

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

Bonjour à tous,

Une idée en passant, valable seulement si tu veux te débarrasser de tout le VBA du classeur : Et si tu essayais d'enregistrer une copie du classeur original en xlsx, est-ce que le VBA ne serait pas supprimé automatiquement ?
Désolé si j'ai dit une bêtise, je n'ai pas suivi le fil et je débarque en cours de route...