CreateEventProc causes crash

[Thomas]

Hi all,

I am quite a newbie to VBA, but with the help of Chip Pearson's
excellent site (thank you!!!) and a lot of trial and error I figured
out how to get where I want.
However, when it comes to event handling, I am stuck and so I hope
someone here finds the mistake in my code.

I'm trying to create a macro that adds event procedures to a workbook.
The workbook consists of several pivot charts. I want every pivot
chart to change its chart type every time the chart is recalculated.

Here's the code I want to be inserted into my chart's modules as a
result of my macro:

Private Sub Chart_Calculate()
ActiveChart.ApplyCustomType ChartType:=xlUserDefined,
TypeName:="My Custom Chart Type"
End Sub


The macro itself:

Sub CreateEventProcedure3(Sheetname As String, Style As String)

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Dim s As String
Dim CodeName As String

s = ActiveWorkbook.VBProject.name 'this is done to prevent empty
codename, learned from <#[email protected]>

CodeName = Charts(Sheetname).CodeName

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(CodeName)
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CreateEventProc("Calculate", "Chart")
LineNum = LineNum + 1
.InsertLines LineNum, " ActiveChart.ApplyCustomType
ChartType:=xlUserDefined, TypeName:= " & DQUOTE & Style & DQUOTE
.VBE.MainWindow.Visible = False
End With
End Sub



Sub Eventmaker()

Application.ScreenUpdating = False
Application.VBE.MainWindow.Visible = False

CreateEventProcedure3 "Chart1", "Type 1"
CreateEventProcedure3 "Chart2", "Type 2"

Application.ScreenUpdating = True
Application.VBE.MainWindow.Visible = False

End Sub

The first call of CreateEventProcedure3 usually works fine, but
afterwards excel crashes. I did not find the exact position where
Excel goes down as it seems to crash kind of delayed.
I mention the pivot charts because when I modify my code to create
events on ordinary work sheets, everything works fine. I' running
Excel 2003 on Win XP.

Did I forget to initialize something? Am I accessing memory in a way I
shouldn't?

Any help is highly appreciated!

Thanks in advance
Thomas

 

[Peter T]

Wasn't sure if I had correctly unwrapped your code but here's my take on
what I think you are trying to do.

Sub test()
' assumes a Chart sheet is active that's NOT in thisworkbook
CreateEventProcedure3 ActiveSheet.Name, "My Custom Chart Type"
End Sub

Sub CreateEventProcedure3(Sheetname As String, sStyle As String)
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long, i As Long
Dim s As String ' ?
Dim sCodeName As String
Dim arrLines(0 To 1) As String
Const DQUOTE = """" ' one " character

arrLines(0) = " ActiveChart.ApplyCustomType ChartType:=xlUserDefined, _"
arrLines(1) = " TypeName:=" & DQUOTE & sStyle & DQUOTE

sCodeName = ActiveWorkbook.Charts(Sheetname).CodeName
If Len(sCodeName) = 0 Then
' flash the VBIDE to update codename of a new sheet
With Application.VBE.MainWindow
.Visible = True
.Visible = False
End With
sCodeName = ActiveWorkbook.Charts(Sheetname).CodeName
End If

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(sCodeName)
Set CodeMod = VBComp.CodeModule

' don't step through this bit, press F5 if necessary
With CodeMod
LineNum = .CreateEventProc("Calculate", "Chart")
For i = 0 To 1
LineNum = LineNum + 1
.InsertLines LineNum, arrLines(i)
Next
End With

End Sub


A few comments:

- Suggest don't re-use Keywords like 'CodeName' & 'Style' as variable names
- Don't step through the code where indicated
- Never attempt to write code to object modules in the same workbook that's
doing the writing, ie don't write to 'own' object modules.
- you only need to use tricks to update the codename if needed (flashing the
VBE is one way), which is when the VBE is closed and a new sheet is added
since the last save/close/reopen.

- And finally, surely you don't want to update the style of the chart every
time it calculates !

For a newbie quite ambitious

Regards,
Peter T

 

[Thomas]

Hi Peter,

thanks for cleaning up my mess a bit
I followed all your hints line by line, and still I could not solve
the problem.
The script runs fine as long as CreateEventProcedure3 is only called
once and the script is finished afterwards. As soon as I ad more code
after the call of that Sub, Excel will crash.

Sub test()
CreateEventProcedure3 "chart 1", "My Custom Chart Type"
'The next line would crash excel:
'CreateEventProcedure3 "chart 2", "My Custom Chart Type"
'this one would crash also:
'Application.Wait(Now + TimeValue("0:00:5"))
'these two lines work fine:
Application.ScreenUpdating = True
Application.VBE.MainWindow.Visible = False
End Sub

What confuses me most is the fact that if I run the script only with
the first call of CreateEventProcedure and afterwards modify the
script (edit Sheet Name) to run it again for the next sheet, it runs
smoothly. What does this mean?

surely you don't want to update the style of the chart every

time it calculates !
I need to because pivot charts loose there style each time they are
changed (KB215904)

Can anybody reproduce my issue? Any hints welcome!

Thanks and best regards,
Thomas

 

[Peter T]

OK, event proc's in multiple modules. Have a go with the following, quite a
few changes -

Sub test()
Dim i As Long
Dim sty As String
Dim sProc As String
Dim arr
Dim arrCodeName() As String
Const Q As String = """"

sty = "My Custom Chart Type"
arr = Array("Chart1", "Chart2") ' << CHANGE

ReDim arrCdNm(LBound(arr) To UBound(arr))

For i = LBound(arr) To UBound(arr)

arrCdNm(i) = ActiveWorkbook.Charts(arr(i)).CodeName
If Len(arrCdNm(i)) = 0 Then
' flash the VBIDE to update codename of a new sheet
With Application.VBE.MainWindow
.Visible = True
.Visible = False
End With
arrCdNm(i) = ActiveWorkbook.Charts(arr(i)).CodeName
End If
Next

For i = 0 To UBound(arrCdNm)
sProc = " 'CreateEventProcedure3 " & _
Q & arrCdNm(i) & Q & _
", " & _
Q & sty & Q & " ' "
Application.OnTime Now, sProc
Next

End Sub

Sub CreateEventProcedure3(sCodeName As String, sStyle As String)
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long, i As Long
Dim arrLines(0 To 1) As String
Const DQUOTE = """" ' double quote

arrLines(0) = " Me.ApplyCustomType ChartType:=xlUserDefined, _"
arrLines(1) = " TypeName:=" & DQUOTE & sStyle & DQUOTE

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(sCodeName)
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CreateEventProc("Calculate", "Chart")
For i = 0 To 1
LineNum = LineNum + 1
.InsertLines LineNum, arrLines(i)
Next
End With

End Sub

If you need to do other suff 'after' the OnTime macros have run, note OnTime
macros all called at the same time get called in reverse order. So code the
'last' Ontime macro 'first', if that makes sense.

I need to because pivot charts loose there style each time they are
changed (KB215904)

Ah, pivot charts, understood.

Regards,
Peter T

 

[Peter T]

There was a typo in the last example with "arrCodeName" which should read
"arrCdNm"

Another approach -

Sub test4()
Dim i As Long
Dim sty As String
Dim arr
Dim arrCdNm() As String

sty = "My Custom Chart Type"
arr = Array("Chart1", "Chart2") ' << CHANGE

ReDim arrCdNm(LBound(arr) To UBound(arr))

For i = LBound(arr) To UBound(arr)

arrCdNm(i) = ActiveWorkbook.Charts(arr(i)).CodeName
If Len(arrCdNm(i)) = 0 Then
' flash the VBIDE to update codename of a new sheet
With Application.VBE.MainWindow
.Visible = True
.Visible = False
End With
arrCdNm(i) = ActiveWorkbook.Charts(arr(i)).CodeName
End If
Next

For i = 0 To UBound(arrCdNm)
CreateEventProcedure4 arrCdNm(i), sty
Next

End Sub

Sub CreateEventProcedure4(sCodeName As String, sStyle As String)

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long, i As Long
Dim arrLines(0 To 2) As String
Const DQUOTE = """" ' double quote

arrLines(0) = "Private Sub Chart_Calculate()"
arrLines(1) = " Me.ApplyCustomType ChartType:=xlUserDefined, " & _
"TypeName:=" & DQUOTE & sStyle & DQUOTE
arrLines(2) = "End Sub"

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(sCodeName)
Set CodeMod = VBComp.CodeModule

With CodeMod
On Error Resume Next
LineNum = 0
LineNum = .ProcBodyLine("Chart_Calculate", vbext_pk_Proc)
On Error GoTo 0
If LineNum Then
' Chart_Calculate() already exists
Else
LineNum = .CountOfLines + 1
For i = 0 To UBound(arrLines)
LineNum = LineNum + 1
.InsertLines LineNum, arrLines(i)
Next
End If
End With

End Sub

This seems to run without any timing problems, even writing chart modules in
'self'
However writing to object modules is very sensitive so no guarantees !

Trust you notice the above now will not write the new event proc if it
already exists (not that was the problem, just to prevent a new one)

Regards,
Peter T

 

[Thomas]

Up and running!
Peter, thank you so much for your support, wouldn't have done it on my
own.
I still did not get the reason why it works, but as long as it does, I
do not bother
I guess by using the OnTime-method excel has a chance to compile the
new procedure properly?

Best regards,
Thomas