D
dolly_care
Hi!
I am creating the worksheets dynamically at runtime. Now, I want to add
the event procedures there itself as soon as I am creating the sheets .
I have tried it by the 2 ways.
1. By the method CreateEventProc -
2. By InsertLines method only - Due the 1. take the focus to vbe
Well, both works fine if we work on one sheet only, but since my
requirment is quite different.
I am adding the sheets in loop, and there i am using the above methods,
but it works one time, and the code doesn;t run after InsertLines code
completes. The excel doesn't response itself, and closes.
Here are my code please check it..
Private Sub CommandButton1_Click()
Dim iCnt As Integer
Dim sName As String
For iCnt = 1 To 5
sName = "Sample_" & iCnt
Sheets.Add(Before:=Worksheets("Sample")).Name = sName
If Not ProcedureExists("Worksheet_Change",
Worksheets(sName).CodeName) Then
Dim ChangeModule
Dim CodeString
Set ChangeModule = Workbooks("Book1.xls").VBProject
'Line1 =
ChangeModule.VBComponents(Worksheets(sName).CodeName).CodeModule.CreateEventProc("Change",
"Worksheet")
CodeString = "Private Sub Worksheet_Change(ByVal Target As
Range)"
CodeString = CodeString & vbLf & "'Testing..."
'CodeString = CodeString & vbLf & "MsgBox ""You have
changed the cell "" & Replace(Target.Address, ""$"", """")"
CodeString = CodeString & vbLf & "MsgBox ""TEST"""
CodeString = CodeString & vbLf & "End Sub"
ChangeModule.VBComponents(Worksheets(sName).CodeName).CodeModule.InsertLines
1, CodeString
'Worksheets(sName).Activate
MsgBox "ddd"
Else
MsgBox "The change event is already exists in the sheet " &
sName
End If
Next
End Sub
Function ProcedureExists(ProcedureName As String, _
ModuleName As String) As Boolean
On Error Resume Next
ProcedureExists = ThisWorkbook.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, vbext_pk_Proc) <> 0
End Function
I would be very thankfull if anyone could help me..
Thanks in advance!
I am creating the worksheets dynamically at runtime. Now, I want to add
the event procedures there itself as soon as I am creating the sheets .
I have tried it by the 2 ways.
1. By the method CreateEventProc -
2. By InsertLines method only - Due the 1. take the focus to vbe
Well, both works fine if we work on one sheet only, but since my
requirment is quite different.
I am adding the sheets in loop, and there i am using the above methods,
but it works one time, and the code doesn;t run after InsertLines code
completes. The excel doesn't response itself, and closes.
Here are my code please check it..
Private Sub CommandButton1_Click()
Dim iCnt As Integer
Dim sName As String
For iCnt = 1 To 5
sName = "Sample_" & iCnt
Sheets.Add(Before:=Worksheets("Sample")).Name = sName
If Not ProcedureExists("Worksheet_Change",
Worksheets(sName).CodeName) Then
Dim ChangeModule
Dim CodeString
Set ChangeModule = Workbooks("Book1.xls").VBProject
'Line1 =
ChangeModule.VBComponents(Worksheets(sName).CodeName).CodeModule.CreateEventProc("Change",
"Worksheet")
CodeString = "Private Sub Worksheet_Change(ByVal Target As
Range)"
CodeString = CodeString & vbLf & "'Testing..."
'CodeString = CodeString & vbLf & "MsgBox ""You have
changed the cell "" & Replace(Target.Address, ""$"", """")"
CodeString = CodeString & vbLf & "MsgBox ""TEST"""
CodeString = CodeString & vbLf & "End Sub"
ChangeModule.VBComponents(Worksheets(sName).CodeName).CodeModule.InsertLines
1, CodeString
'Worksheets(sName).Activate
MsgBox "ddd"
Else
MsgBox "The change event is already exists in the sheet " &
sName
End If
Next
End Sub
Function ProcedureExists(ProcedureName As String, _
ModuleName As String) As Boolean
On Error Resume Next
ProcedureExists = ThisWorkbook.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, vbext_pk_Proc) <> 0
End Function
I would be very thankfull if anyone could help me..
Thanks in advance!