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")
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
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
