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

[pat66]

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

 

[job75]

Bonjour patricklopez66,

Indiquer l'extension du fichier en H27 de la feuille "V3" :

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]

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]

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]

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

 

[job75]

Avant de vous donner cette macro je l'ai testée, il n'y a aucun problème.

Sauf bien sûr si l'une des 3 feuilles nommées dans l'Array messheets n'existe pas...

 

[pat66]

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]

Bonsoir patricklopez66,

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+

 

[pat66]

Bonjour job75

c'est parfait, exactement ce qu'il me fallait, un grand merci pour votre aide Job75

Sur les conseils de Staple1600, j'ouvre un autre fil pour un problème de zone d'impression

a bientôt