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

 

[Pierrot93]

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

Re,

C'est quoi le problème ??? perso, peux pas aller sur ton site, problème de proxy...

 

[Pierrot93]

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

Re,

bonjour toto, pas 2007 sous le coude, mais ton idée devrait fonctionner me semble-t-il....

 

[Imy55]

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

Re,

bonjour toto, pas 2007 sous le coude, mais ton idée devrait fonctionner me semble-t-il....

Oui elle doit fonctionner mais il y a un problème quelque part.
Merci pour ton aide Pierrot
Jespère que KenDev se connecte se soir car cette macro est son idée.

 

[tototiti2008]

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

Bonjour Pierrot
Re,

Evidement, en 2003 et antérieurs, seulement la solution proposée par Pierrot et KenDev
En 2007, un truc comme (ATTENTION, sauvegarder le classeur avant !!!)

Application.displayalerts = False
Thisworkbook.saveas Filename:="c:\toto.xslx", FileFormat:=xlopenxmlworkbook
Application.displayalerts = True

devrait le faire

 

[Pierrot93]

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

Re,

A noter tout de même, ceci ne devrait pas fonctionner dans ton code :

VbC.Remove v

pour supprimer "module1" en plus des usf :

Dim v As Object
With ThisWorkbook.VBProject
    For Each v In .VBComponents
        If v.Type = 3 Then .VBComponents.Remove .VBComponents(v.Name)
        If v.Name = "Module1" Then .VBComponents.Remove .VBComponents(v.Name)
    Next v
End With

 

[Imy55]

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

Voici la nouvelle Macro qui ne fonctionne toujours pas,(Les Userform, le module11 et le code this workbook ne sont pas supprimés dans les nouveau fichier enregistrés) je suis vraiment nulle en programmation :
Merci tutotiti2008 et Pierrot

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)
        If v.Name = "Module11" Then .VBComponents.Remove .VBComponents(v.Name)
      Select Case v.Name
        Case "ThisWorkbook"
            'suppression des lignes du modules
           v.CodeModule.DeleteLines 1, v.CodeModule.CountOfLines
    End Select
    Next v
End With
'sauver et fermer la copie
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Private Sub CommandButton5_Click()
Call enregistrer_classeur_bis(ThisWorkbook.Path & "\Etudes\" & Worksheets("Entreprise").Range("H6") & ".xlsm"), FileFormat:=xlOpenXMLWorkbook
End Sub

 

[KenDev]

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

Bonsoir à tous,

La proposition que j'avais faite hier et renouvelée par Tototiti d'enregistrer en xlsx n'a pas eu beaucoup d'écho auprès d'Imy.. Une nouvelle proposition donc en formulant l'hypothèse que le but à atteindre est d'avoir un xlsx ne contenant que la feuille "Entreprise" et en utilisant le FileFormat de TotoTiti (encore lui ). La sub a été déplacée dans le module de l'userform. Rien n'est supprimé, un xlsx est ajouté et la feuille copiée. A tester sur une copie du classeur. Je ne peux travailler sur le fichier megaupload, l'userform étant de dimension bien trop grande pour mon netbook! Cordialement

KD

Private Sub CommandButton4_Click()
Call enregistrer_classeur_bis
End Sub

Private Sub enregistrer_classeur_bis()
Dim oWb As Workbook, nWb As Workbook, FNm$, SNm$, oWs As Worksheet, v As Object

Set oWb = ThisWorkbook
SNm = "Entreprise"
Set oWs = oWb.Worksheets(SNm)
FNm = oWs.Cells(6, 8)

Workbooks.Add
Set nWb = ActiveWorkbook
Application.DisplayAlerts = False
nWb.Worksheets(2).Delete
nWb.Worksheets(2).Delete
Application.DisplayAlerts = True

nWb.Worksheets(1).Name = FNm
oWs.Cells.Copy Destination:=nWb.Worksheets(1).Cells(1, 1)
Application.DisplayAlerts = False
nWb.SaveAs Filename:=oWb.Path & "\Etudes\" & FNm & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
nWb.Close
End Sub

 

[Imy55]

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

Salut KenDev,Heureuse pour ton retour ^^.
En fait il existe plusieurs feuilles à part « Entreprise » et ils contiennent des macro.
J’ai supprimé les feuilles pour diminuer la taille du fichier.
Est-ce que l’existence d’autres feuilles ne change rien ? Si non qu’elle est la partie du code dans laquelle je dois ajouter les autres feuilles.
Stp une autre question KD pourquoi le code d’hier fonctionne pour Supprimer « Frmpermanant » et dans la version ou il y a plusieurs form il ne fonctionne plus (ben il fonctionne mais partiellement

 

[Imy55]

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

Oui la macro supprime toutes les autres feuilles à part la feuille "Entreprise" qui lui donne le nom de la cellule H6. waw. Mais en moins il ya plus de ré-exécution des Userform hh.
Non sérieusement j'ai besoin de concerver les autres feuilles où il y a des macros de calcul très importantes que j'ai fait à l'aide des membres du Forum.
Je pense que cette partie du code qui copie et colle les feuilles dans le nouveau fichier :

oWs.Cells.Copy Destination:=nWb.Worksheets(1).Cells(1, 1)

donc je peux faire la même chose pour toute les autres feuilles :

oWs.Cells.Copy Destination:=nWb.Worksheets(2).Cells(1, 1)
oWs.Cells.Copy Destination:=nWb.Worksheets(3).Cells(1, 1)
oWs.Cells.Copy Destination:=nWb.Worksheets(4).Cells(1, 1)

Dans ce cas toutes les feuilles auront le même nom ce qui donne une erreur
Mais comment puis-je conserver les macros de ces feuilles

 

[KenDev]

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

Bonsoir à tous,

Mon hypothèse était fausse donc. Un nouvel essai avec la même logique pourtant.

Je ne sais pas pourquoi le code d'hier marchait dans un cas et pas dans d'autre.

Cordialement

KD

Private Sub enregistrer_classeur_bis()

Dim oWb As Workbook, nWb As Workbook
Dim oWs As Worksheet, so As Worksheet, sn As Worksheet
Dim VbP As Object, VbC As Object, v As Object, mo As Object
Dim i%, FNm$, SNm$, s$

Set oWb = ThisWorkbook
Set VbP = oWb.VBProject
Set VbC = VbP.VBComponents
SNm = "Entreprise"
Set oWs = oWb.Worksheets(SNm)
FNm = oWs.Cells(6, 8)

Workbooks.Add
Set nWb = ActiveWorkbook
If oWb.Worksheets.Count > nWb.Worksheets.Count Then
    For i = nWb.Worksheets.Count + 1 To oWb.Worksheets.Count
        nWb.Sheets.Add
    Next i
End If
For i = 1 To oWb.Worksheets.Count
    Set so = oWb.Worksheets(i)
    Set sn = nWb.Worksheets(i)
    so.Cells.Copy Destination:=sn.Cells(1, 1)
    sn.Name = so.Name
    sn.Visible = so.Visible
    Set mo = oWb.VBProject.VBComponents.Item(so.CodeName)
    s = mo.Codemodule.Lines(1, mo.Codemodule.CountOfLines)
    nWb.VBProject.VBComponents.Item(sn.CodeName).Codemodule.AddFromString (s)
Next i

Set mo = oWb.VBProject.VBComponents.Item("Thisworkbook")
s = mo.Codemodule.Lines(1, mo.Codemodule.CountOfLines)
nWb.VBProject.VBComponents.Item("Thisworkbook").Codemodule.AddFromString (s)

Application.DisplayAlerts = False
nWb.SaveAs Filename:=oWb.Path & "\Etudes\" & FNm & ".xlsm", FileFormat:=52
Application.DisplayAlerts = True
nWb.Close
End Sub

 

[Imy55]

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

La macro d’hier est plus performante que celle-là.
Pour la macro d’hier il nous faut juste régler le problème de suppression des Userform.
Par contre celle d’aujourd’hui elle n’enregistre pas le classeur avec le nom de H6, elle copie toutes les feuilles vides …
Donc j’ai toujours une copie du projet avec cette Macro ^^.
(Je commence à avoir honte de mes postes)
Je suis désolée si je te dérange KD

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", "Frmpermanant", "Frmapropos", "Frmentreprise"
            '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

 

[KenDev]

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

C'est étrange, celle d'aujourd'hui chez moi copie toutes les feuilles avec leur contenu et avec leur module de code respectif. De même avec le code du classeur. Bref sont supprimés les modules standards et les userforms.

Cordialement

KD

 

[Imy55]

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

C'est étrange, celle d'aujourd'hui chez moi copie toutes les feuilles avec leur contenu et avec leur module de code respectif. De même avec le code du classeur. Bref sont supprimés les modules standards et les userforms.

Cordialement

KD

Il y a un problème avec cette ligne (erreur: argument ou appel de procedure incorrecte)
s = mo.Codemodule.Lines(1, mo.Codemodule.CountOfLines)
Là je commence à perdre l'éspoire à chaque fois un problème différent.
(J'ai une soutenance le vendredi et j'arrive même pas à réaliser une seule partie de mes privisions)
Ci joint le Classeur enregistré par la macro d'aujourd'hui

 

[KenDev]

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

Je sais plus trop quoi te dire Imy, chez moi le Classeur enregistré par la macro d'aujourd'hui est un xlsm déjà, pas un xlsx...

 

[Imy55]

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

Je sais plus trop quoi te dire Imy, chez moi le Classeur enregistré par la macro d'aujourd'hui est un xlsm déjà, pas un xlsx...

Merci KD tu as fait ce quel faut avec moi et même plus. Merci beaucoup

(Est ce que je peux ouvrir une nouvelle discussion?