XL 2016 Enregistrer un fichier sans les macros

KTM

XLDnaute Impliqué
Bonjour chers tous
Je voudrais enregistrer une copie de mon fichier mais sans les macros tout en supprimant les boutons (formes) sur cette copie.
je voudrais pouvoir ensuite fermer la copie tout en laissant ouvert l'original.
j'ai élaboré un code mais il me semble incomplet.
VB:
Sub Sauve()
Dim chemin$, fichier$
chemin = ThisWorkbook.Path & "\Sauvegarde\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
With Sheets("BASE")
fichier = Month(.[A1]) & "_" & "Analyse-FA " & .[A2] & Format(.Range("A1"), " mmmm yyyy")
End With
Application.DisplayAlerts = False
ThisWorkbook.SaveAs chemin & fichier, 51
End Sub
 

Pièces jointes

  • FICHIER A.xlsm
    16.3 KB · Affichages: 2

patricktoulon

XLDnaute Barbatruc
Simple précis!!
Mais les boutons (Formes) restent toujours sur la copie. MERCI.
re
je reprends donc l'idée de @job75
entre deux je shunte les shapes mais ici de l'activeworkbook
j'ai pas testé mais si cette astuce fonctionne comme je crois c'est bon
j'ai mis "toto" je ne connais pas le nom de ta feuille
VB:
Sub Sauvegarder()Dim fn$,shap as shape
Application.DisplayAlerts = False
With ThisWorkbook
fn = .FullName 'mémorise

SaveAs .Path & "\Sauvegarde.xlsx", 51
for each shap in activeworkbook.sheets("toto")..shapes
shap.delete
next

.SaveAs fn, 52 'état initial
End With
End Sub
;)
 

job75

XLDnaute Barbatruc
Mais les boutons (Formes) restent toujours sur la copie. MERCI.
Le plus simple est de ne pas les supprimer mais de les masquer :
VB:
Sub Sauvegarder()
Dim fn$
Application.DisplayAlerts = False
With ThisWorkbook
    fn = .FullName 'mémorise
    ActiveSheet.DrawingObjects.Visible = False 'masque les objets
    .SaveAs .Path & "\Sauvegarde.xlsx", 51
    ActiveSheet.DrawingObjects.Visible = True 'affiche les objets
    .SaveAs fn, 52 'état initial
End With
End Sub
En supposant qu'il n'y a qu'une feuille (sinon il faudrait faire une boucle).
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Je voudrais enregistrer une copie de mon fichier mais sans les macros tout en supprimant les boutons (formes) sur cette copie.

VB:
Sub Sauvegarder()
Dim fn$,shap as shape
Application.DisplayAlerts = False
With ThisWorkbook fn = .FullName 'mémorise

SaveAs .Path & "\Sauvegarde.xlsx", 51
for each shap in activeworkbook
.sheets("toto")..shapes shap.delete
next

.SaveAs fn, 52 'état initial
End With
End Sub
🤔
 
Dernière édition:

job75

XLDnaute Barbatruc
re
là pour moi c'est pas du @job75🤣
plus simple oui mais pas propre
si ces shapes ne doivent plus exister dans les copies autant les supprimer non?
Je maintiens que le masquage est la bonne solution.

Maintenant s'il y a beaucoup d'objets il vaut mieux les supprimer.

Mais alors il faut rouvrir le fichier .xlsx :
VB:
Sub Sauvegarder()
Dim fn$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
    fn = .FullName 'mémorise
    .SaveAs .Path & "\Sauvegarde.xlsx", 51
    .SaveAs fn, 52 'état initial
    With Workbooks.Open(.Path & "\Sauvegarde.xlsx") 'rouvre le fichier
        ActiveSheet.DrawingObjects.Delete 'supprime les objets
        .Close True 'enregistre et ferme
    End With
End With
End Sub
 

job75

XLDnaute Barbatruc
Si le fichier ne contient qu'une feuille :
VB:
Sub Sauvegarder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Copy 'nouveau document
ActiveSheet.DrawingObjects.Delete 'supprime les objets
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Sauvegarde.xlsx", 51
ActiveWorkbook.Close
End Sub
 

KTM

XLDnaute Impliqué
Le plus simple est de ne pas les supprimer mais de les masquer :
VB:
Sub Sauvegarder()
Dim fn$
Application.DisplayAlerts = False
With ThisWorkbook
    fn = .FullName 'mémorise
    ActiveSheet.DrawingObjects.Visible = False 'masque les objets
    .SaveAs .Path & "\Sauvegarde.xlsx", 51
    ActiveSheet.DrawingObjects.Visible = True 'affiche les objets
    .SaveAs fn, 52 'état initial
End With
End Sub
En supposant qu'il n'y a qu'une feuille (sinon il faudrait faire une boucle).
cette réponse me va.
Merci à tous
 

Discussions similaires

Réponses
0
Affichages
762
Réponses
6
Affichages
1 K

Statistiques des forums

Discussions
313 274
Messages
2 096 750
Membres
106 738
dernier inscrit
Lacbus