PDA

View Full Version : Adding Code to Workbook_BeforeOpen



MWE
01-05-2017, 12:34 AM
I am (still!) running xl2003 under WinXP

I have a spreadsheet file called A.xls with code module ModA and a procedure within that module SubA

I am creating (using VBA) an extract of A.xls (specific tabs from A.xls) called B.xls to which is programatically added ModA. This has been running fine. I now wish to programatically "add" object Workbook_BeforeSave to the workbook object of B.xls and add a call to SubA to Workbook_BeforeSave.

How might I do this?

Thanks

GTO
01-05-2017, 03:23 AM
... I now wish to programatically "add" object Workbook_BeforeSave to the workbook object of B.xls...

Hi there,

I think a bit more specificity would help us:yes. For instance, do you have specific code that you want to add to the BeforeSave event in B.xls, or, do you want to copy the code from BeforeSave in A.xls to B.xls's ThisWorkbook module, or, ???


... and add a call to SubA to Workbook_BeforeSave.

I am confused about what this part means.

Mark

MWE
01-05-2017, 05:00 AM
Hi there,

I think a bit more specificity would help us:yes. For instance, do you have specific code that you want to add to the BeforeSave event in B.xls, or, do you want to copy the code from BeforeSave in A.xls to B.xls's ThisWorkbook module, or, ???


... and add a call to SubA to Workbook_BeforeSave.

I am confused about what this part means.


Mark
Thanks for the reply. Yes, I wish to add a specific line of code to the BeforeSave event in B.xls In particular, a call to SubA

SamT
01-05-2017, 08:51 AM
Does B.xls already have the Before Save sub?

GTO
01-05-2017, 09:52 AM
Lightly tested, but this should handle with or without BeforeSave already existing. It does not test for the Standard Module's 'ModA' existence in 'B.xls', as you state you have that part already handled. Nor does it check if the code to insert already exists in the case that BeforeSave already exists.



Option Explicit

' Define constants in case late-bound
Private Enum ModuleType
StandardModule = 1 ' Standard module
ClassModule = 2 ' Class module
MSForm = 3 ' Microsoft Form
ActiveXDesigner = 11 ' ActiveX Designer
Document = 100 ' Document (Worksheet or Workbook) Module
End Enum

Sub example()
Dim WB As Workbook
Dim vbaProj As VBIDE.VBProject ' or As Object for late-bound
Dim vbaComp As VBIDE.VBComponent ' SAA
Dim n As Long
Dim lFirstLineOfProcedure As Long
Dim bolFoundProcedure As Boolean
Dim bolVBEisVisible As Boolean

'// Ensure workbook is open... //
On Error Resume Next
Set WB = Application.Workbooks("B.xls")
On Error GoTo 0
'// ...or bail. //
If WB Is Nothing Then Exit Sub

Set vbaProj = WB.VBProject

For Each vbaComp In vbaProj.VBComponents
'// A worksheet has under 100 properties, so the combined test should ensure we are //
'// getting a reference to 'ThisWorkbook' in 'B.xls'. //
If vbaComp.Type = ModuleType.Document And vbaComp.Properties.Count > 100 Then
Exit For
End If
Next

If Not vbaComp Is Nothing Then

'// See if the event proceedure already exists. //
For n = 1 To (vbaComp.CodeModule.CountOfDeclarationLines + vbaComp.CodeModule.CountOfLines + 1)
If InStr(1, vbaComp.CodeModule.Lines(n, 1), "Sub Workbook_BeforeSave") > 0 Then
bolFoundProcedure = True
lFirstLineOfProcedure = n
Exit For
End If
Next

'// At least for me, if we CreateEventProcedure, VBE pops up. So... see if it is //
'// visible and handle. //
bolVBEisVisible = vbaProj.VBE.MainWindow.Visible

'// If the procedure doesn't already exist, create it. //
If Not bolFoundProcedure Then
lFirstLineOfProcedure = vbaComp.CodeModule.CreateEventProc("BeforeSave", "Workbook")
End If

'// Add the line of code and save 'B.xls'.
vbaComp.CodeModule.InsertLines lFirstLineOfProcedure + 1, " Call ModA.SubA"
Application.EnableEvents = False
DoEvents
WB.Save
Application.EnableEvents = True

If Not bolVBEisVisible Then
If vbaProj.VBE.MainWindow.Visible Then
vbaProj.VBE.ActiveWindow.Visible = False
vbaProj.VBE.MainWindow.Visible = False
End If
Else
vbaProj.VBE.ActiveWindow.Visible = False
End If

End If

End Sub


Hope that helps,

Mark

@SamT: Happy New Year and the best to you and yours :hi:

SamT
01-05-2017, 10:18 AM
TY

MWE
01-06-2017, 03:52 AM
Hope that helps,

Mark

@SamT: Happy New Year and the best to you and yours :hi:



Thanks, this approach works well.

GTO
01-06-2017, 04:00 AM
Happy to help and thanks for the feedback:beerchug: