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

Signaler
Messages postés
197
Date d'inscription
mercredi 30 mai 2007
Statut
Membre
Dernière intervention
13 mai 2009
-
Messages postés
197
Date d'inscription
mercredi 30 mai 2007
Statut
Membre
Dernière intervention
13 mai 2009
-
 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

1 réponse

Messages postés
197
Date d'inscription
mercredi 30 mai 2007
Statut
Membre
Dernière intervention
13 mai 2009

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