Comment supprimer les macros d'un fichier crée et enregistrer avec la macro du fRésolu

Question

Bonjour, voilà j'ai un problème, je dois créer une macro permettant de sauvegarder dans un nouveau fichier le résultat du filtre du classeur source. Voilà le code que j'ai mis en place le problème c'est qu'après la suppression des boutons macro de la feuille ma macro s'arrête ... je vous mets mon code : Private Sub CommandButton4_Click() Dim nouveau As Variant Dim cherche As String Dim fichier As String Dim chemin As String Dim Nfichier As String Dim n As Integer Dim n1 As Integer 'Format Heure XX-XX-XX Dim H As String Dim M As String Dim S As String H = Hour(Time) M = Minute(Time) S = Second(Time) H = Format(H, "00") M = Format(M, "00") S = Format(S, "00") 'Chemin fichier source chemin = "D:\O.01159.1.01 (IEG CCG Blenod)\GDE- Gestion Données Entrée Etudes" 'Chemin fichier copier nouveau = "D:\O.01159.1.01 (IEG CCG Blenod)\GDE- Gestion Données Entrée Etudes\Filtre Liste Documents Applicables" 'Nom fichier source cherche = "Liste Documents Applicables - Rév 1.xls" fichier = Dir(chemin) Nfichier = "Filtre_" & Date$ & "_" & H & "-" & M & "-" & S & ".xls" If fichier = cherche Then ' fichier trouvé ' demande du nouveau nom nouveau = Application.GetSaveAsFilename(nouveau & Nfichier) If nouveau <> False Then ' fichier saisi ? ActiveWorkbook.SaveAs nouveau ' sauvegarde nouveau MsgBox "Sauvé sous " & nouveau ' message Workbooks.Open Filename:=(chemin & cherche) n = Workbooks.Count n1 = Workbooks.Count While (n <> 0) If Workbooks(n).Name <> cherche Then Call Supp_Bouton(n, n1) Workbooks(n).Close End If n = n - 1 Wend Else MsgBox "Classeur non sauvegardé" End If End If End Sub Private Function Supp_Bouton(n, n1) Workbooks(n).Activate Sheets("Liste applicables").Select ActiveSheet.Shapes.Range(Array("CommandButton4", "CommandButton3", "CommandButton2")).Select Selection.Delete Workbooks(n1).Activate Workbooks(n).Save End Function MerZi ... Zi ... Zi ... PtitCat P.S:DSL pour l'orthographe

VB_PtitCat · Accepted Answer

AutoSolution :


Ca supprime pas les macros, mais comme c'est des boutons de macro je les supprime juste et ça suffit.

Private Sub CommandButton4_Click()
...
...
..
.
cherche =  "Liste Documents Applicables - Rév 1.xls"
fichier = Dir(chemin)
Nfichier = "Filtre_" & Date$ & "_" & H & "-" & M & "-" & S & ".xls"
    
    If fichier = cherche Then               '  fichier trouvé
                                            '  demande du nouveau nom
        nouveau = Application.GetSaveAsFilename(nouveau & Nfichier)
        If nouveau <> False Then            '  fichier saisi ?
            ActiveWorkbook.Save Copy As nouveau   '  sauvegarde nouveau
            MsgBox "Sauvé sous " & nouveau  '  message
            Workbooks.Open Filename: =(Nfichier)
            ActiveSheet.Shapes.Range(Array("CommandButton4",_
...,"CommandButton2")).Select
            Selection.Delete
                        Workbooks(n).Save
                        Workbooks(n).Close
        Else
            MsgBox "Classeur non sauvegardé"
        End If
    End If
End Sub

MerZi ... Zi ... Zi ... PtitCat   
                                 P.S:DSL pour l'orthographe

Comment supprimer les macros d'un fichier crée et enregistrer avec la macro du f

1 réponse

Votre réponse

Discussions similaires