Sub VBA_EXPORT_AND_KILL()
ExporterFrmEtModules
VBA_Killer
End Sub
Sub ExporterFrmEtModules()
Dim Racine As String
Dim SousRep As String
Racine = "C:\Temp\"
SousRep = "C:\Temp\Feuilles\"
If (RépertoireExiste(Racine) <> True) Then
MkDir Racine
End If
If (RépertoireExiste(SousRep) <> True) Then
MkDir SousRep
End If
Dim LeFich
For Each LeFich In ThisWorkbook.VBProject.VBComponents
Select Case LeFich.Type
Case 1
ThisWorkbook.VBProject.VBComponents(LeFich.Name).Export Racine & LeFich.Name & ".bas"
Case 2
ThisWorkbook.VBProject.VBComponents(LeFich.Name).Export Racine & LeFich.Name & ".cls"
Case 3
ThisWorkbook.VBProject.VBComponents(LeFich.Name).Export Racine & LeFich.Name & ".frm"
Case 100
ThisWorkbook.VBProject.VBComponents(LeFich.Name).Export SousRep & LeFich.Name & ".cls"
End Select
Next
End Sub
'-------------------------------------------------------
'Test L'existance d'un répertoire
'-------------------------------------------------------
Function RépertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RépertoireExiste = GetAttr(Chemin) And vbDirectory
End Function
Sub VBA_Killer()
Dim VBC As Object
With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else
.VBComponents.Remove VBC
End If
Next VBC
End With
End Sub