Esses códigos são em VBS, ou seja, coloque num arquivo por exemplo disassemble.vbs e assemble.vbs *(ou quaisquer nomes que vc quiser)
Leia, entenda, edite o que achar necessário. Use con cuidado. Faça cópias de segurança de tudo antes de se aventurar aqui 
Para usar, bastará dar duplo clique no vbs, ou na linha de comando do DOS, digitar o nome do VBS.
Segue os códigos para:
a) Desmontar o xlsm:
Dim shell, fso
Dim objExcel, objWorkbook, objVBComp
Dim fileName, file, codeDir, sfx, blackstone, programFile
Set objExcel = CreateObject("Excel.Application")
objExcel.EnableEvents = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = WScript.CreateObject("WScript.Shell")
blackstone = fso.GetFolder("C:Program FilesiLevelExcel")
If WScript.Arguments.Count = 0 Then
fileName = "MDET.xls"
Else
fileName = WScript.Arguments.Item(0)
blackstone = shell.currentDirectory
End If
programFile = fso.BuildPath(blackstone, fileName)
If Not fso.FileExists(programFile) Then
WScript.Echo "File '" & programFile & "' doesn`t exist."
WScript.Quit
End If
codeDir = fso.BuildPath(shell.CurrentDirectory, "NewCode")
If Not fso.FolderExists(codeDir) Then
fso.CreateFolder codeDir
End If
ClearFolder codeDir
Set objWorkbook = objExcel.Workbooks.Open(programFile)
For Each objVBComp in objWorkbook.VBProject.VBComponents
' WScript.Echo " Name: " & objVBComp.Name & " Type: " & objVBComp.Type
Select Case objVBComp.Type
Case 1 ' vbext_ct_StdModule
sfx = ".bas"
Case 2 ' vbext_ct_ClassModule
sfx = ".cls"
Case 3 ' vbext_ct_MSForm
sfx = ".frm"
Case 100 ' vbext_ct_Document
' sfx = ".sheet"
Case Else
' sfx = ""
' WScript.Echo "UNKNOWN Script Type: " & objVBComp.Type & " Name: " & objVBComp.Name
End Select
If sfx <> "" Then
' WScript.Echo "Export Script Type: " & objVBComp.Type & " Name: " & objVBComp.Name & " to " & sfx & " file"
objVBComp.Export fso.BuildPath(codeDir, objVBComp.Name & sfx)
End If
Next
objWorkbook.Close
objExcel.Quit
CompareAndDelete
WScript.Echo "File " & programFile & " has been successfully disassembled."
WScript.Quit
Sub ClearFolder(path)
Dim folder, file
If fso.FolderExists(path) Then
Set folder = fso.GetFolder(path)
For Each file in folder.Files
file.Delete true
Next
Else
' WScript.Echo "No such folder. Create."
fso.CreateFolder path
End If
End Sub
Sub CompareAndDelete
Dim shell, fso, oldFolder, oldFile, oldStream, oldContents, newFolder, newFile, newStream, newContents
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oldFolder = fso.GetFolder("Code")
Set newFolder = fso.GetFolder("NewCode")
For Each newFile in newFolder.Files
oldFile = fso.BuildPath(oldFolder, newFile.Name)
If fso.FileExists (oldFile) Then
sfx = LCase(fso.GetExtensionName(newFile.Name))
If (sfx <> "frx") Then
Set oldStream = fso.OpenTextFile(oldFile, 1)
Set newStream = fso.OpenTextFile(newFile, 1)
oldContents = oldStream.ReadAll
newContents = newStream.ReadAll
oldStream.Close
newStream.Close
If (oldContents = newContents) Then
fso.DeleteFile newFile
End If
End If
End If
Next
End Sub
b) Montar o xlsm:
Dim shell, fso
Dim objExcel, objWorkbook, objVBComp
Dim file, name, sfx, codeFolder, codeFile, blackstone, programFile, imgFolder, imgFile, targetImgFile
Set objExcel = CreateObject("Excel.Application")
objExcel.EnableEvents = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile("EmptyDET.xls")
file.Copy "DET.xls", true
Set file = fso.GetFile("DET.xls")
file.Attributes = file.Attributes AND 0
Set objWorkbook = objExcel.Workbooks.Open(file.Path)
Set codeFolder = fso.GetFolder("Code")
For Each codeFile in codeFolder.Files
sfx = LCase(fso.GetExtensionName(codeFile.Name))
name = fso.GetBaseName(codeFile.Name)
If (sfx = "cls" or sfx = "frm" or sfx = "bas") Then
RemoveComponent objWorkbook, name
' WScript.Echo "Import " & codeFile.Path
objWorkbook.VBProject.VBComponents.Import codeFile.Path
Else
' WScript.Echo "NOT PROCESSED " & codeFile.Name
End If
Next
objWorkbook.Save
objWorkbook.Close
objExcel.Quit
If Not fso.FolderExists("C:Program FilesiLevel") Then
fso.CreateFolder "C:Program FilesiLevel"
End If
If Not fso.FolderExists("C:Program FilesiLevelExcel") Then
fso.CreateFolder "C:Program FilesiLevelExcel"
End If
blackstone = fso.GetFolder("C:Program FilesiLevelExcel")
programFile = fso.BuildPath(blackstone, file.Name)
If fso.FileExists (programFile) Then
fso.DeleteFile (programFile)
End If
fso.MoveFile file, programFile
WScript.Echo "File " & programFile & " has been successfully created."
WScript.Quit
Sub RemoveComponent(objWorkbook, name)
On Error Resume Next
Set objVBComp = objWorkbook.VBProject.VBComponents(name)
If objVBComp.Type = 1 or objVBComp.Type = 2 or objVBComp.Type = 3 or objVBComp.Type = 100 Then
' WScript.Echo "Remove " & name
objWorkbook.VBProject.VBComponents.Remove objVBComp
End If
end sub
Postado : 24/04/2015 5:52 am