MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Copying Workbook Event Procedure Programatically


Posted by Bill on October 25, 2000 11:19 AM

I have a macro that creates a series of new workbooks. I need to copy Module1 from a source book to each new book, and I need to copy Workbook_Activate from the source book to each new book.

I was able to copy Module1 by using:

ActiveWorkbook.VBProject.VBComponents _
"Module1").Export Filename:="code1.bas"
Workbooks.Add
ActiveWorkbook.VBProject.VBComponents.Import_
Filename:="code1.bas"

How do I copy (or even programatically rewrite) the workbook_activate event handler?

Thanks,

Bill


Posted by Ivan Moala on October 26, 2000 2:26 AM

Bill
here is a routine I did a while ago to do this;
You will have to change it to reference the correct
event & sheet

Sub Modify_Modules()
'===================================================================
'= Procedure: Modify_Modules =
'= Type: Subprocedure =
'= =
'= Purpose: Add a Procedure to a module including Sheets and =
'= Thisworkbook =
'= Parameters: None =
'= Returns: Nothing =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |13-May-00| Ivan F Moala | Created =
'===================================================================

Dim ModEvent As CodeModule 'Module to Modified
Dim LineNum As Long 'Line number in module
Dim SubName As String 'Event to change as text
Dim Proc As String 'Procedure string
Dim EndS As String 'End sub string
Dim Ap As String 'Apostrophe
Dim Tabs As String 'Tab
Dim LF As String 'Line feed or carriage return

Ap = Chr(34)
Tabs = Chr(9)
LF = Chr(13)
EndS = "End Sub"

'Your ChangeEvent Procedure OR SubRoutine
SubName = "Private Sub Workbook_SheetChange(ByVal Sh As Object," & _
"ByVal Target As Excel.Range)" & LF

'Your Procedure
Proc = "If Target.Row = 1 Then" & LF
Proc = Proc & Tabs & "MsgBox " & Ap & "Testing row number =" & Ap & " & Target.Address" & LF
Proc = Proc & "End If" & LF

'Use activeWorkbook so that it can act on another open/Active workbook
Set ModEvent = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
With ModEvent
LineNum = .CountOfLines + 1
.InsertLines LineNum, SubName & Proc & EndS
End With
End Sub

Ivan

Posted by Bill on October 27, 2000 4:13 PM

Ivan,

Thanks for that macro. I came upon this bit of code which also does the trick:
-----------------
' Create an object reference
' for the workbook event handlers
Set WBCodeMod1 = Workbooks(CurrentTemplate) _
.VBProject.VBComponents _("ThisWorkbook").CodeModule

Set WBCodeMod2 = Workbooks(CurrentClassFile) _
.VBProject.VBComponents("ThisWorkbook") _
.CodeModule

'Copy the Workbook level Event handlers
WBCodeMod2.insertlines 1, _
WBCodeMod1.Lines(1, WBCodeMod1.countoflines)
------------
Bill

Posted by Ivan Moala on October 27, 2000 4:15 PM


Bill, thanks for that bit of code....


Ivan