PDA

View Full Version : Delete then Insert Procedure



gnod
01-26-2008, 10:55 PM
Hi,

i need to patch or modify the procedure the mistake i made with my templates. how do i programmatically delete then replace the procedure of Workbook_BeforeClose(Cancel As Boolean) in the thisworkbook.. i need to change the templates in a closed workbook..

From this procedure

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dtTestDate As Date

' If the test date is less than todays date, the file will not be saved
With Worksheets("Annual_EmpInfoSheet")
If .Range("Annual_HeaderData_BudgetYr") <> "" Then
dtTestDate = DateValue("1/15/" & .Range("Annual_HeaderData_BudgetYr"))
If dtTestDate < Date Then
MsgBox "Any changes you made will not be save. Annual Budget is already done."
Application.ThisWorkbook.Saved = True
Application.ThisWorkbook.Close
End If
End If
End With
End Sub


To this procedure

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dtTestDate As Date

' If the test date is less than todays date, the file will not be saved
With Worksheets("Annual_EmpInfoSheet")
If .Range("Annual_HeaderData_BudgetYr") <> "" And Range("BudgetType").value = "Annual" Then 'Additional condition
dtTestDate = DateValue("1/15/" & .Range("Annual_HeaderData_BudgetYr"))
If dtTestDate < Date Then
MsgBox "Any changes you made will not be save. Annual Budget is already done."
Application.ThisWorkbook.Saved = True
Application.ThisWorkbook.Close
End If
End If
End With
Enable_SaveAndSaveAs ' Additional
End Sub

kindly assist..
:help

thanks..

Bob Phillips
01-27-2008, 12:14 AM
Sub DeleteProcedure()
Dim VBProj As Object
Dim VBComp As Object
Dim CodeMod As Object
Dim mpProcedure As String
Dim mpStartLine As Long
Dim mpNumLines As Long

Set VBProj = ActiveWorkbook.VBProject

Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

mpProcedure = "Workbook_BeforeClose"
With CodeMod

mpStartLine = .ProcStartLine(mpProcedure, 0) 'vbext_pk_Proc
mpNumLines = .ProcCountLines(mpProcedure, 0) 'vbext_pk_Proc
.DeleteLines StartLine:=mpStartLine, Count:=mpNumLines

mpStartLine = .CreateEventProc("BeforeClose", "Workbook") + 1
.InsertLines mpStartLine, _
"Dim dtTestDate As Date" & vbNewLine & vbNewLine & _
"' If the test date is less than todays date, the file will not be saved" & vbNewLine & _
" With Worksheets(""Annual_EmpInfoSheet"")" & vbNewLine & _
" If .Range(""Annual_HeaderData_BudgetYr"") <> """" And _" & vbNewLine & _
" .Range(""BudgetType"").Value = ""Annual"" Then 'Additional condition" & vbNewLine & _
" dtTestDate = DateValue(""1/15/"" & .Range(""Annual_HeaderData_BudgetYr""))" & vbNewLine & _
" If dtTestDate < Date Then" & vbNewLine & _
" MsgBox ""Any changes you made will not be save. Annual Budget is already done.""" & vbNewLine & _
" Application.ThisWorkbook.Saved = True" & vbNewLine & _
" Application.ThisWorkbook.Close" & vbNewLine & _
" End If" & vbNewLine & _
" End If" & vbNewLine & _
" End With" & vbNewLine & _
"Enable_SaveAndSaveAs ' Additional" & vbNewLine & _
"End Sub"
End With
End Sub

gnod
01-27-2008, 12:45 AM
thanks xld.. :thumb
is it possible to change the Workbook_BeforeClose procedure of a closed workbook?..

Bob Phillips
01-27-2008, 01:28 AM
No, not really, as the VBA is embedded in the binary file, certainly in pre-2007 Excel.

gnod
01-27-2008, 01:43 AM
do you have a suggestion how i will patch my procedure to the users? i already deploy my templates last year for their 2008 annual budget, now they will use it again for their 2008 mid-year budget.. the templates is more than 200 files and i don't want to open the file then modify the procedure for each everyone..

pls :help


thanks

Bob Phillips
01-27-2008, 10:23 AM
Do the open, modify in a loop



Public Sub LoopFilesAndUpdate()
Dim mpFilename As String
Dim mpWB As Workbook

mpFilename = Dir("C:\test\*.xls")

Do While mpFilename <> ""

Set mpWB = Workbooks.Open(mpFilename)
Call AmendProcedure(mpWB)
mpWB.Save
mpWB.Close
mpFilename = Dir
Loop

End Sub

Private Sub AmendProcedure(ByRef wb As Workbook)
Dim VBProj As Object
Dim VBComp As Object
Dim CodeMod As Object
Dim mpProcedure As String
Dim mpStartLine As Long
Dim mpNumLines As Long

Set VBProj = wb.VBProject

Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

mpProcedure = "Workbook_BeforeClose"
With CodeMod

mpStartLine = .ProcStartLine(mpProcedure, 0) 'vbext_pk_Proc
mpNumLines = .ProcCountLines(mpProcedure, 0) 'vbext_pk_Proc
.DeleteLines StartLine:=mpStartLine, Count:=mpNumLines

mpStartLine = .CreateEventProc("BeforeClose", "Workbook") + 1
.InsertLines mpStartLine, _
"Dim dtTestDate As Date" & vbNewLine & vbNewLine & _
"' If the test date is less than todays date, the file will not be saved" & vbNewLine & _
" With Worksheets(""Annual_EmpInfoSheet"")" & vbNewLine & _
" If .Range(""Annual_HeaderData_BudgetYr"") <> """" And _" & vbNewLine & _
" .Range(""BudgetType"").Value = ""Annual"" Then 'Additional condition" & vbNewLine & _
" dtTestDate = DateValue(""1/15/"" & .Range(""Annual_HeaderData_BudgetYr""))" & vbNewLine & _
" If dtTestDate < Date Then" & vbNewLine & _
" MsgBox ""Any changes you made will not be save. Annual Budget is already done.""" & vbNewLine & _
" Application.ThisWorkbook.Saved = True" & vbNewLine & _
" Application.ThisWorkbook.Close" & vbNewLine & _
" End If" & vbNewLine & _
" End If" & vbNewLine & _
" End With" & vbNewLine & _
"Enable_SaveAndSaveAs ' Additional" & vbNewLine & _
"End Sub"
End With
End Sub

gnod
01-28-2008, 06:21 PM
thanks for your reply.. i'll try your solution..

thanks :thumb