Modification Macro

[Pierrick66]

Bonjour,

Le fichier suivant me permet de créer des devis automatiquement.
Sur la feuille "DEVIS" le bouton "ENREGISTRER SOUS" me permet d'enregistrer le fichier avec le nom contenue en cellule C6.

Je souhaiterai que dans les fichiers crée le bouton "ENREGISTRER SOUS" ainsi que la macro correspondante sous effacé.

Est-ce possible

PS: La macro doit toujours rester dans le fichier ci-joint mais plus dans les fichiers crée via le bouton "ENREGISTRER SOUS"

Merci

 

[vgendron]

Hello

Ci dessous un bout de code que j'avais réalisé dans un autre projet
à adapter à ton besoin

Application.DisplayAlerts = False 'on désactive les messages d'alerte pour éviter d'avoir à confirmer la sauvegarde au format xlsx qui ne contient plus les macros
'on enregistre sous le nom constitué du chemin complet et nomfichier + extension .xlsx pour supprimer les macro
ActiveWorkbook.SaveAs Filename:=CheminCompletNomFichier & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'*************************************************************************************
'supprimer dans la nouvelle feuille les boutons
For Each sh In ActiveSheet.Shapes 'Boutons qui portent un nom contenant BT
    If sh.Name Like "BT*" Then sh.Delete
Next sh
'**************************************************

ActiveWorkbook.Close savechanges:=True 'on ferme la demande
Application.DisplayAlerts = True 'on REACTIVE les messages d'alerte
[code]

 

[Pierrick66]

Le problème d'enregistrer en xlsx c'est que toute les macros vont être désactivé or j'ai besoin juste de supprimer celle ci et de garder les autres

 

[jpb388]

Bonjour à tous
regarde ici : https://www.developpez.net/forums/d...fice/excel/contribuez/supprimer-macros-macro/

 

[Pierrick66]

Malheureusement ce n'est pas exactement ça que je cherche.

Je vais esssayer de m'expliquer clairement

Dans la Feuille DEVIS le bouton "ENREGISTRER SOUS" me permet d'enregistrer un fichier en fonction du contenu de C6.
Ce que je souhaiterai c'est que ce bouton et la macro associé soit supprimer dans chaque nouveau fichier qui sera enregistré.

Est ce possible ?

Cordialement

 

[vgendron]

Hello
il me semble que cette partie répond à ton besoin..

Sub Supprimer_Macro_Precise()
Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "Module3"
NomMacro = "Macro1"

With ThisWorkbook.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
End With

End Sub

evidemment. tu auras pris le soin de modifier
NomMod
NomMacro
ET remplacer ThisWorkbook par le nom du classeur nouvellement créé

 

[Pierrick66]

Elle supprime dans le classeur actuel pas dans le classeur crée non ?

 

[vgendron]

Elle supprime dans le classeur actuel pas dans le classeur crée non ?

pas sur que tu aies vu: j'ai édité mon post précédent.. ce qui répond à ta question ;-)

 

[Pierrick66]

Hello

Sub Supprimer_Macro_Precise()
Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "Module1"
NomMacro = "EnregistrerSous"

With Filename="C\Users\Desktop\DEVIS" & Range("C6").VBProject.VBComponents(NomMod).CodeModule
Debut = .ProcStartLine(NomMacro, 0)
Lignes = .ProcCountLines(NomMacro, 0)
.DeleteLines Debut, Lignes
End With

End Sub

Si je suis le truc je doit faire ceci? Et l'affecter a un bouton ou non ?

 

[vgendron]

je pense que ton with filename=... ne va pas plaire à VBA

essaie plutot un truc du genre

Sub Supprimer_Macro_Precise()
Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "Module3"
NomMacro = "Macro1"
set Wb=workbooks("NOMNOUVEAUCLASSEUR.xls")

With Wb.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
End With

End Sub

et oui, pour le bouton

 

[Pierrick66]

Le problème est que le nom du classeur est aléatoire en fonction de la cellule C6.

Je voudrais que ça se fasse automatiquement sans avoir à appuyer sur un bouton...

Est ce possible

 

[Pierrick66]

J'ai un collègue qui m'a fait ce code

Sub EnregistrerSous()
    Dim nWb$, chDos$
    nWb = ActiveSheet.Range("C6") & ".xlsm"
    chDos = "C:\Users\oem\Desktop\DEVIS\"
    ThisWorkbook.SaveCopyAs chDos & nWb
    With Workbooks.Open(chDos & nWb)
   With .VBProject.VBComponents
            .Remove .Item("Module2")
        End With
        .Worksheets("Devis").Shapes("Rectangle 1").Delete
        .Close True
    End With
    Application.Quit
End Sub

Le problème c'est que j'ai une erreur sur la ligne

With VBProject.VBComponents

Pouvez vous m'aider ?