Hi ste,
thank's very much, you put me on the right way.
Here is a part of code I use to do what I want. There is more with it in an
hta.
Again, thank's for your help.
'--------------------------------------------------------------------------------------------------
'
================================================== ===============================================
' TITLE: ReplaceMacro
'
' PURPOSE: Open each Excel files in a specified folder, Delete all
vbcode in ThisWorkbook.
' Open a text file containing a new vbcode and insert it in module
' ThisWorkbook in each Excel files. Save the file and close Excel.
'
' PARAMETERS: strSourceFolder [STRING] = Folder containing Excel files to
work with.
'
' HOW TO USE: ReplaceMacro strSourceFolder
'
================================================== ===============================================
Sub ReplaceMacro(strSourceFolder)
Dim objFSO, objFolder, objFile, objComps, objComp
'Instantiate objects.
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Connect to folder to work with.
Set objFolder = objFSO.GetFolder(strSourceFolder)
'Loop through all files in current folder.
For Each objFile In objFolder.Files
ProgressWindow strSourceFolder & "\" & objFile.Name, "Open"
objXLS.Workbooks.Open strSourceFolder & "\" & objFile.Name 'Open Excel file.
Set objComps = objXLS.ActiveWorkbook.VBProject.VBComponents 'Connect to
VBE module.
ProgressWindow strSourceFolder & "\" & objFile.Name, "Del"
'Delete
vb code in ThisWorkbook Project.
DelMacro objComps, objComp
'Insert module code in module named ThisWorkbook.
ProgressWindow strSourceFolder & "\" & objFile.Name, "Insert"
AddProcedure objComps
ProgressWindow strSourceFolder & "\" & objFile.Name, "Save"
objXLS.ActiveWorkbook.Save 'Save workbook and close it.
Next
End Su
'--------------------------------------------------------------------------------------------------
'
================================================== ===============================================
' TITLE: DelMacro
'
' PURPOSE: Delete all macro code in an Excel file.
'
' PARAMETERS: vbComps [OBJECT] = Contain components code module collection.
' cbComp [OBJECT] = Contain Vbcode itself in a module.
'
' HOW TO USE: DelMacro objComps, objComp
'
================================================== ===============================================
Sub DelMacro(vbComps, vbComp)
'Delete
vb code in ThisWorkbook Project.
For Each vbComp In vbComps
Select Case vbComp.Name
Case "ThisWorkbook" 'If name of current module is ThisWorkbook,
Delete code in it.
With vbComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End Su
'--------------------------------------------------------------------------------------------------
'
================================================== ===============================================
' TITLE: AddProcedure
'
' PURPOSE: Add a new procedure in module ThisWorkbook based on a text
file.
'
' PARAMETERS: vbComps [OBJECT] = Contain components code module collection.
'
' HOW TO USE: AddProcedure objComps
'
================================================== ===============================================
Sub AddProcedure(objVBModule)
On Error Resume Next
Dim objFSO
Dim intLineNum
Dim strCode
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open code.txt file which is the template macro code for Excel to copy in
module Achat.
Set strTemplFile = objFSO.OpenTextFile(SrcTemplateFolderName.Value &
"\code.txt")
'Connect to module Achat.
Set objVbModule =
objXLS.ActiveWorkbook.VBProject.VBComponents("This Workbook").CodeModule
'Loop through each lines in code.txt file and add each line in module Achat.
Do Until strTemplFile.AtEndOfStream
'Read line one by one.
strCode = strTemplFile.ReadLine
intLineNum = intLineNum + 1 'Increment line number counter.
On Error Resume Next
objVbModule.InsertLines intLineNum, strCode 'Add line of code in module.
Loop
'Clean up objects.
strTemplFile.Close
Set objFSO = Nothing
End Sub
"ste" wrote:
Hi Christian,
this is just the opposite ... : )
but with a bit of editing... I guess it's the right way
Sub DeleteMyCode()
'On Error Resume Next
Dim m_ThisWB
Set m_ThisWB =
ThisWorkbook.VBProject.VBComponents.Item(1).Collec tion("ThisWorkbook").CodeModule
m_ThisWB.deletelines 4, m_ThisWB.countoflines
m_ThisWB.deletelines 2
DeleteComponent "Mod1"
DeleteComponent "Mod2"
DeleteComponent "Class1"
ThisWorkbook.Save
End Sub
Sub DeleteComponent(sz_CompName As String)
Dim vbc
Set vbc = ThisWorkbook.VBProject.VBComponents.Item(sz_CompNa me)
ThisWorkbook.VBProject.VBComponents.Remove vbc
End Sub