Sub SaveWithoutMacros()
'Purpose : To save a copy of the active workbook without macros
'But : Pour créer une copie du classeur actif sans macros
'PLEASE NOTE : You must choose Tools, References and select the
'Microsoft Visual Basic for Applications Extensibility library
'NOTER SVP : Vous devez aller dans Outils, Références et cocher
'Microsoft Visual Basic for Applications Extensibility library
Dim vFilename As Variant
Dim wbActiveBook As Workbook
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
On Error GoTo CodeError
'Get a filename to save as
vFilename = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbooks,*.xls", _
Title:="Copie du classeur sans les macros")
If vFilename = False Then Exit Sub 'Utilisateur choisit d'annuler
ActiveWorkbook.SaveCopyAs vFilename
Set wbActiveBook = Workbooks.Open(vFilename)
'Now strip all VBA, modules, userforms from the copy
'Supprimer maintenant tout le code VBA, les modules, userforms de la copie
'This code is from Chip Pearson's website [url=http://www.cpearson.com]Excel Redirect[/url]
Set VBComps = wbActiveBook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, _
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
wbActiveBook.Save
Exit Sub
CodeError:
MsgBox Err.Description, vbExclamation, "Une erreur s'est produite"
End Sub