XL 2019 Sauvegarder classeur en xlsx et xlsm avec le même bouton et fermer classeur original

pat66

XLDnaute Impliqué
Bonoir à tous,
j'ai une macro qui fonctionne très bien, 'merci à PatrickToulon et Stapple1600), mais je souhaite avec le même bouton, pouvoir enregistrer aussi en xlsm et fermer le classeur
voici la macro en xlsx,
Private Sub CommandButton5_Click()
Dim NOM_PRECIS$, vEMPLACEMENT$, messheets
Application.EnableEvents = False
messheets = Array("Feuil1", "Feuil2", "Feuil5") 'mettre les noms de sheets que tu veux ici
;)
If Sheets("V3").Range("G27") = "" Then
If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
Else
NOM_PRECIS = Sheets("V3").Range("G27").Value & "_" & Format(Now, "dd-mm-yyyy") & ".xlsx"
vEMPLACEMENT = ThisWorkbook.Path & "\"
Sheets(messheets).Copy ' a pour effet de copier les sheets dans un new classeur
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs vEMPLACEMENT & NOM_PRECIS
.Close
End With
End If
'peut on fermer aussi le xlsm <<!!sans fermer Excel ?>>!!
'ben...
ThisWorkbook.Close
Application.DisplayAlerts = True
End Sub

un grand merci pour votre aide
 
Solution
Bonsoir patricklopez66,
VB:
Private Sub CommandButton5_Click()
Dim messheets, NOM$, EMPLACEMENT$
messheets = Array("Feuil1", "Feuil2", "Feuil5") 'mettre les noms de sheets que tu veux ici
If Sheets("V3").Range("G27") = "" Then
    If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
Else
    NOM = Sheets("V3").Range("G27") & "_" & Format(Now, "dd-mm-yyyy")
    vEMPLACEMENT = ThisWorkbook.Path & "\"
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs vEMPLACEMENT & NOM, 52 'xlsm
    Sheets(messheets).Copy ' a pour effet de copier les sheets dans un new classeur
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    With ActiveWorkbook
        .SaveAs vEMPLACEMENT...

job75

XLDnaute Barbatruc
Bonjour patricklopez66,

Indiquer l'extension du fichier en H27 de la feuille "V3" :
VB:
Private Sub CommandButton5_Click()
Dim messheets, NOM$, FORM As Byte, vEMPLACEMENT$
messheets = Array("Feuil1", "Feuil2", "Feuil5") 'mettre les noms de sheets que tu veux ici
If Sheets("V3").Range("G27") = "" Then
    If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
ElseIf Sheets("V3").Range("H27") <> "xlsx" And Sheets("V3").Range("H27") <> "xlsm" Then
    If MsgBox("Vous devez préciser l'extension du fichier xlsx ou xlsm !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
Else
    NOM = Sheets("V3").Range("G27") & "_" & Format(Now, "dd-mm-yyyy")
    FORM = IIf(Sheets("V3").Range("H27") = "xlsx", 51, 52)
    vEMPLACEMENT = ThisWorkbook.Path & "\"
    Sheets(messheets).Copy ' a pour effet de copier les sheets dans un new classeur
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs vEMPLACEMENT & NOM, FORM
        .Close
    End With
End If
'peut on fermer aussi le xlsm <<!!sans fermer Excel ?>>!!
'ben...
ThisWorkbook.Close
End Sub
A+
 

pat66

XLDnaute Impliqué
Bonsoir, merci pour votre aide,

l'ai testé la macro mais je souhaite que cela s'enregistre dans les 2 formats d'extention (XLSX et XLSM) automatiquement sans choix possible et sans confirmation, est ce possible ? sinon je mets 2 boutons


merci
 

job75

XLDnaute Barbatruc
VB:
Private Sub CommandButton5_Click()
Dim messheets, NOM$, EMPLACEMENT$
messheets = Array("Feuil1", "Feuil2", "Feuil5") 'mettre les noms de sheets que tu veux ici
If Sheets("V3").Range("G27") = "" Then
    If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
Else
    NOM = Sheets("V3").Range("G27") & "_" & Format(Now, "dd-mm-yyyy")
    vEMPLACEMENT = ThisWorkbook.Path & "\"
    Sheets(messheets).Copy ' a pour effet de copier les sheets dans un new classeur
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs vEMPLACEMENT & NOM, 52
        .SaveAs vEMPLACEMENT & NOM, 51
        .Close
    End With
End If
'peut on fermer aussi le xlsm <<!!sans fermer Excel ?>>!!
'ben...
ThisWorkbook.Close
End Sub
 

pat66

XLDnaute Impliqué
bonsoir
je viens de tester la macro elle bloque à ce niveau = Sheets(messheets).Copy, et ne exécute pas
alors j'ai tester en désactivant Sheets(messheets).Copy et elle fonctionne très bien, mais forcément le classeur est copié entièrement, alors en xlsm c'est très bien, mais xlsx il me faut selectionner les feuilles pour la copie (voir plus haut), avez vous une idée ?

merci
 

pat66

XLDnaute Impliqué
Effectivement je devais être fatigué, elle fonctionne très bien, j'ai dû mal écrire les noms de mes sheets,
Et en fait je viens de m'apercevoir qu'il faudrait que la copie extraite en XLSM soit complète, c'est à dire identique au classeur original, mais avec le nom de la cellule (If Sheets("V3").Range("G27")
Qu'en pensez vous ?
Ce dont j'ai besoin ;
j'ouvre un classeur, on clique le command bouton qui effectue 3 actions:
Il ferme l'original sans modification
Il enregistre un XLSX avec un nom dans une cellule avec des feuilles sélectionnées
Il enregistre un XLSM une copie de l'original modifié avec nom de cellule

merci mille fois
 

job75

XLDnaute Barbatruc
Bonsoir patricklopez66,
VB:
Private Sub CommandButton5_Click()
Dim messheets, NOM$, EMPLACEMENT$
messheets = Array("Feuil1", "Feuil2", "Feuil5") 'mettre les noms de sheets que tu veux ici
If Sheets("V3").Range("G27") = "" Then
    If MsgBox("Vous devez préciser le nom du client !", vbOKOnly + vbInformation, "vous informe") = vbAbort Then Exit Sub
Else
    NOM = Sheets("V3").Range("G27") & "_" & Format(Now, "dd-mm-yyyy")
    vEMPLACEMENT = ThisWorkbook.Path & "\"
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs vEMPLACEMENT & NOM, 52 'xlsm
    Sheets(messheets).Copy ' a pour effet de copier les sheets dans un new classeur
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    With ActiveWorkbook
        .SaveAs vEMPLACEMENT & NOM, 51 'xlsx
        .Close
    End With
End If
'peut on fermer aussi le xlsm <<!!sans fermer Excel ?>>!!
'ben...
ThisWorkbook.Close
End Sub
A+
 

Discussions similaires

Statistiques des forums

Discussions
311 707
Messages
2 081 734
Membres
101 809
dernier inscrit
HADER2024