Creating An Event Procedure
 

Hello all, Tom Ogilvy helped me extensively last night to get the above
working. I now have the problem that if i include the code within my
routine it breaks the code and the routine stops. The code is below and
after i have inserted this code in the code section of "sheet1" i need
to carry on with my routine to protect and save the workbook. can
anybody help me with this please ?

Sub InsertProc()
Dim sname As String
Dim StartLine As Long
sname = ActiveSheet.CodeName
With ActiveWorkbook.VBProject.VBComponents(sname).CodeM odule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim VRange As Range"
.InsertLines StartLine + 1, "Set VRange =
ActiveSheet.Columns(""H:H"")"
.InsertLines StartLine + 2, "Target.Font.ColorIndex
= 3"
.InsertLines StartLine + 3, "Target.Font.Bold =
True"
End With
End Sub
Thank you in advance

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Creating An Event Procedure
 

I copied you code from the email and placed it in the general module of a
workbook (then cleaned it up for the word wrap).

I opened a second workbook.

I executed the code.

It created the change event in the active sheet. When I edited a cell in
the active sheet, the code changed the font to red.

There isn't anything inherently wrong with the code.

Sub InsertProc()
Dim sname As String
Dim StartLine As Long
sname = ActiveSheet.CodeName
With ActiveWorkbook.VBProject.VBComponents(sname).CodeM odule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, _
"Dim VRange As Range"
.InsertLines StartLine + 1, _
"Set VRange =ActiveSheet.Columns(""H:H"")"
.InsertLines StartLine + 2, _
"Target.Font.ColorIndex = 3"
.InsertLines StartLine + 3, _
"Target.Font.Bold = True"
End With
End Sub


Try disabling events in your macro before you execute the above.

Sub Mycode()

' code
Application.EnableEvents = False
' now call insertproc
InsertProc

' more code
' save and close the workbook

' turn on events
Application.EnableEvents = True

End Sub

--
Regards,
Tom Ogilvy


"Les Stout" wrote in message
...
Hello all, Tom Ogilvy helped me extensively last night to get the above
working. I now have the problem that if i include the code within my
routine it breaks the code and the routine stops. The code is below and
after i have inserted this code in the code section of "sheet1" i need
to carry on with my routine to protect and save the workbook. can
anybody help me with this please ?

Sub InsertProc()
Dim sname As String
Dim StartLine As Long
sname = ActiveSheet.CodeName
With ActiveWorkbook.VBProject.VBComponents(sname).CodeM odule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, "Dim VRange As Range"
.InsertLines StartLine + 1, "Set VRange =
ActiveSheet.Columns(""H:H"")"
.InsertLines StartLine + 2, "Target.Font.ColorIndex
= 3"
.InsertLines StartLine + 3, "Target.Font.Bold =
True"
End With
End Sub
Thank you in advance

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Creating An Event Procedure
 

Hi Tom, wasn't sure if you were around yet.... here in SA it is 2 PM.
thanks a lot, will try.

best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Creating An Event Procedure
 

Hello Tom, I do not know what i am doing wrong, i put your code in below
and tried it but i get an error message again ? As soon as i get to the
Colummns ("H:H")line.
The message i get is Run-Tim eerror'-2147417848(890010108)'
Automation error The object invoked has disconnected from its clients. ?

Sub Mycode()

' code
Application.EnableEvents = False
' now call insertproc
InsertProc

' more code
Columns("H:H").Locked = False ' ---This line
ActiveSheet.Protect Password:="secret", Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
' save and close the workbook

' turn on events
Application.EnableEvents = True
SaveFileE
End Sub

To continue i need to protect, save and then send in an e-mail. should i
save it, close and then go and fetch it again ?


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Creating An Event Procedure
 

I experience the same, but this worked: I added a line to your change proc
( me.Protect UserInterfaceOnly:=true, Password:="secret"), otherwise the
change macro errors since the sheet is protected

So you need to break your macro into two pieces.


Sub BBB()
InsertProc
Application.OnTime Now, "BBB_2"
End Sub

Sub BBB_2()
Application.EnableEvents = False
Columns("H:H").Locked = False ' ---This line
ActiveSheet.Protect Password:="secret", Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True

End Sub
Sub InsertProc()
Dim sname As String
Dim StartLine As Long
sname = ActiveSheet.CodeName
With ActiveWorkbook.VBProject.VBComponents(sname).CodeM odule
StartLine = .CreateEventProc("Change", "Worksheet") + 1
.InsertLines StartLine, _
"Dim VRange As Range"
.InsertLines StartLine + 1, _
"Set VRange =ActiveSheet.Columns(""H:H"")"
.InsertLines StartLine + 2, _
"Me.Protect UserInterfaceOnly:=True," & _
" Password:=""secret"""
.InsertLines StartLine + 3, _
"Target.Font.ColorIndex = 3"
.InsertLines StartLine + 4, _
"Target.Font.Bold = True"
End With
End Sub

--
Regards,
Tom Ogilvy

"Les Stout" wrote in message
...
Hello Tom, I do not know what i am doing wrong, i put your code in below
and tried it but i get an error message again ? As soon as i get to the
Colummns ("H:H")line.
The message i get is Run-Tim eerror'-2147417848(890010108)'
Automation error The object invoked has disconnected from its clients. ?

Sub Mycode()

' code
Application.EnableEvents = False
' now call insertproc
InsertProc

' more code
Columns("H:H").Locked = False ' ---This line
ActiveSheet.Protect Password:="secret", Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
' save and close the workbook

' turn on events
Application.EnableEvents = True
SaveFileE
End Sub

To continue i need to protect, save and then send in an e-mail. should i
save it, close and then go and fetch it again ?


Les Stout

*** Sent via Developersdex http://www.developersdex.com ***