Application Crash Whie adding Code lines using VBA

[Amit Kumar]

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").CodeModule
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

 

[Peter T]

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).CodeModule
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("B34")
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

 

[Robert Bruce]

Yn newyddion: %[email protected],

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.

See also the CreateEventProc method.

Rb

 

[Amit Kumar]

I already tried using CreateEventProc... But getting same error.

 

[Peter T]

Although CreateEventProc ensures the event is correctly written, providing
the control already exists, it has the possible disadvantage of opening the
VBE to display the new event. Also I very much doubt it would prevent the
crash problem, which I'd bet is related to an untimely recompile of the
project while the code is running. That depends of course on what you are
doing overall as I mentioned previously.

In the AddLabel routine I posted, forgot to remove a couple of lines
accidentally left in for my own testing.

Set ole = ws.OLEObjects(2)
and a bit further down -
Set ole = ws.OLEObjects(1).

Regards,
Peter T