I've amended your routine slightly and with the test all seems to work OK.
Having said that, there are scenarios where adding event code to class
modules can cause the project to recompile and crash Excel (eg under certain
circumstances when adding new code to the project that's running the insert
new code).
If the following doesn't work it's probably related to what you are doing
overall.
Sub WriteEventHandler(LabelName As String, sModName As String)
Dim LineNum As Long
Dim RenameCodeMod As Object
Const DQUOTE = """"
Set RenameCodeMod = _
ActiveWorkbook.VBProject.VBComponents(sModName).Co deModule
With RenameCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Private Sub " & LabelName _
& "_DblClick(ByVal Cancel As MSForms.ReturnBoolean)"
LineNum = LineNum + 1
.InsertLines LineNum, " CurName = " & Trim(LabelName) &
".Caption"
LineNum = LineNum + 1
.InsertLines LineNum, _
" newname = InputBox(" & DQUOTE & _
"Enter new name for " & DQUOTE & " & CurName, " _
& DQUOTE & "Rename" & DQUOTE & ",CurName)"
LineNum = LineNum + 1
.InsertLines LineNum, _
" If Len(Trim(newname)) 0 Then " _
& Trim(LabelName) & ".Caption = Trim(newname)"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
End Sub
Sub AddLabel()
Dim sName As String, sCodeName As String
Dim ws As Worksheet
Dim ole As OLEObject
Set ws = ActiveSheet
Set ole = ws.OLEObjects(2)
sCodeName = ws.CodeName
' note newly added sheet won't return codename until saved or
' unless the VBE is open or unless other trick done to re-compile
Set ole = ActiveSheet.OLEObjects(1)
With Range("B3:D4")
Set ole = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.Label.1", _
Left:=.Left, Top:=.Top, _
Width:=.Width, Height:=.Height)
End With
ole.Object.Caption = "Double-click me to change caption"
ole.Object.BackColor = RGB(210, 210, 250)
sName = ole.Name
WriteEventHandler sName, sCodeName
End Sub
Regards,
Peter T
"Amit Kumar" <Amit
wrote in message
...
Hi,
Executing the code given below throws an error:
"Microsoft Office Excel has encountered a problem and needs to close. We
are sorry for the inconvenience."
But If I remove first insertLine statement that is ".InsertLines LineNum,
"Private Sub.........." the program is excuting fine.
Please help me on this.
Thanks!!
Sub WriteEventHandler(LabelName As String)
Dim LineNum As Long
Const DQUOTE = """"
Set RenameCodeMod =
ActiveWorkbook.VBProject.VBComponents("Sheet1").Co deModule
With RenameCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub " + LabelName +
"_DblClick(ByVal
Cancel As MSForms.ReturnBoolean)"
LineNum = LineNum + 1
.InsertLines LineNum, " CurName = " + Trim(LabelName) +
".Caption"
LineNum = LineNum + 1
.InsertLines LineNum, " newname = InputBox(" + DQUOTE + "Enter
new name for " + DQUOTE + " + CurName, " + DQUOTE + "Rename" + DQUOTE + ",
CurName)"
LineNum = LineNum + 1
.InsertLines LineNum, " If Len(Trim(newname)) 0 Then " +
Trim(LabelName) + ".Caption = Trim(newname)"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
End Sub