Enregistrer sous avec une macro

[TAL59]

Bonjour,
Je voudrais enregistrer sous un fichier A à l' aide d' une macro puis supprimer cette macro du nouveau fichier B
Problème le fichier B reste ouvert
Pouvez-vous m' aider
Merci
A+TAL59

 

[job75]

Re : Enregistrer sous avec une macro

Bonjour TAL59,

Supprimer une macro c'est un peu rasoir.

Alors voyez cette macro dans le fichier A(1) joint :

Sub Sauvegarder()
Dim i As Integer
With Application
  .ScreenUpdating = False
  .SheetsInNewWorkbook = Worksheets.Count
  Workbooks.Add
  .SheetsInNewWorkbook = 3
  .DisplayAlerts = False 'au cas où le fichier B.xls existe déjà
End With
With ActiveWorkbook
  For i = 1 To Worksheets.Count 'pour renommer les feuilles
   .Worksheets(i).Name = "zzzzz" & i
  Next
  For i = 1 To Worksheets.Count
    ThisWorkbook.Worksheets(i).Cells.Copy .Worksheets(i).Cells
    .Worksheets(i).Name = ThisWorkbook.Worksheets(i).Name
  Next
  .SaveAs ThisWorkbook.Path & "\B.xls"
  .Close
End With
End Sub

Inconvénient (ou avantage ??) de cette méthode : il n'y a plus aucune macro dans le fichier B.xls...

Edit : bien sûr téléchargez d'abord le fichier !

A+

 

[job75]

Re : Enregistrer sous avec une macro

Re,

Voici une solution qui supprime les macros souhaitées du fichier B.xls.

Sur Excel 2003, il faut que la case "Faire confiance au projet Visual Basic" ait été cochée (menu Outils-Macro-Sécurité-Editeurs approuvés").

Je testerai plus tard sous Excel 2010.

Les macros dans Module1 :

Sub Sauvegarder()
Dim nomfich As String
On Error Resume Next
Workbooks("B.xls").Close False 'nom à adapter
On Error GoTo 0
Application.DisplayAlerts = False 'au cas où le fichier B.xls existe déjà
With ThisWorkbook
  nomfich = .Name
  .SaveAs .Path & "\B.xls" 'chemin et nom à adapter
  Workbooks.Open .Path & "\" & nomfich
End With
Application.OnTime Now, nomfich & "!SupprimerMacros"
End Sub

Sub SupprimerMacros()
Dim w As Worksheet
With Workbooks("B.xls") 'nom à adapter
  .VBProject.VBComponents("Module1").CodeModule.DeleteLines 1, 25
  .VBProject.VBComponents("Feuil1").CodeModule.DeleteLines 1, 3
  For Each w In .Worksheets
    If w.CodeName = "Feuil1" Then w.OLEObjects("CommandButton1").Delete
  Next
  .Close True
End With
End Sub

Fichier (2) joint.

A+

 

[job75]

Re : Enregistrer sous avec une macro

Re,

Testé le fichier (2) sous Excel 2010 : aucun problème.

Il suffit de cocher la case "Accès approuvé au modèle d'objet du projet VBA" (onglet Développeur-Sécurité des macros).

A+

 

[job75]

Re : Enregistrer sous avec une macro

Bonjour TAL59, le forum,

Cette macro, avec SaveCopyAs, est nettement plus propre :

Sub Sauvegarder()
Dim nomfichier$, fichier$, Fname$, Fcode$, module$, bouton$
'---à adapter---
nomfichier = "B.xls"
fichier = ThisWorkbook.Path & "\" & nomfichier
Fname = Feuil1.Name
Fcode = "Feuil1"
module = "Module1"
bouton = "CommandButton1"
'---sauvegarde---
On Error Resume Next
Workbooks(nomfichier).Close False 'sécurité...
On Error GoTo 0
ThisWorkbook.SaveCopyAs fichier
'---suppression du bouton et des macros (voir n° des lignes)---
Application.ScreenUpdating = False
Workbooks.Open fichier
With Workbooks(nomfichier)
  .Sheets(Fname).OLEObjects(bouton).Delete
  With .VBProject
    .VBComponents(Fcode).CodeModule.DeleteLines 1, 3
    .VBComponents(module).CodeModule.DeleteLines 1, 26
  End With
  .Close True
End With
End Sub

Fichier (3) joint.

A+