Macro Execution stops.

[ety]

Hello.
I have a problem with the following code

Dim strProcLine As String
    With ActiveWorkbook.VBProject.VBComponents(ActiveChart.CodeName).CodeModule
   ' MsgBox ok
 
    ' adaugat procedura goala
     .CreateEventProc "Calculate", "Chart"
    'MsgBox ok
    strProcLine = "Format_Chart"
   ' MsgBox ok
    .InsertLines .ProcBodyLine("Chart_Calculate", 0) + 1, strProcLine
   ' MsgBox ok
    End With
   ' MsgBox ok

This is part of a larger macro, wich makes 2 pivottables and for each PT a chart, and for each chart i create an even procedure (Chart_Activate) wich calls a procedure to format the chart. Tha macro is alocated to the click even on a button in the sheet where i get the information from.
If i run the macro(click the button) with Microsoft Visual Basic Editor opened all goes ok. But if i close Microsoft Visual Basic Editor and then run the macro it stops right before .CreateEventProc "Calculate", "Chart" of the first chart , and i can't understand why. No error mesages delivered, nothing.
Please help me.
Thank You.

 

[xld]

Have you Trusted access to VB Project in the security tab?

 

[ety]

Have you Trusted access to VB Project in the security tab?

Do u mean tools/macro/security? It is set on low. And the problem still persists.
By the way, i'm using MS Office 2000


One more thing i forgot to tell in previous post:

• when i was running the macro with the editor opened i observed that it automatically opened new code pages for each chart that i was creating the even procedure. But when running the macro with the editor closed the code for the chart(because only first chart and pivot table is created) is empty

If neded i will post all the code in here, although it needs some improvements.

 

[xld]

I do mean Tools>Macro>Security, but on the second tab, Trusted Publishers, there is a Trust Acess to Visual Basic Projects checkbox.

 

[ety]

I do mean Tools>Macro>Security, but on the second tab, Trusted Publishers, there is a Trust Acess to Visual Basic Projects checkbox.

The list there is empty, Button is disabled, and the only checkbox in the tab is checked.(Trust all instaled add-ins and templates)

 

[ety]

can anybody help please?

 

[ety]

up

 

[ety]

I've decided to copy/paste all the code. maybe someone can figure it out

Sub Macro1()
 
On Error GoTo ErrHandler:
Sheets("Procente").Delete
Sheets("Status").Delete
Sheets("Valori").Delete
Sheets("Status1").Delete
'find last row
Dim LastRow As Long
  If WorksheetFunction.CountA(Cells) > 0 Then
    'Search for any entry, by searching backwards by Rows.
    LastRow = Cells.Find(What:="*", After:=[A1], _
                         SearchOrder:=xlByRows, _
                         SearchDirection:=xlPrevious).Row
 
  End If
' find last column
  Dim LastColumn As Integer
  If WorksheetFunction.CountA(Cells) > 0 Then
    'Search for any entry, by searching backwards by Columns.
    LastColumn = Cells.Find(What:="*", After:=[A1], _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious).Column
 
  End If
 
 
    Dim WSD As Worksheet
    Set WSD = Sheets.Add
    WSD.Name = "Status"
    For Each PT In WSD.PivotTables
    PT.TableRange2.Clear
    Next PT
 
   'pivot +chart procente
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
    SourceData:="Sheet1!R1C1:R" & LastRow & "C" & LastColumn).CreatePivotTable TableDestination:=WSD. _
        Cells(3, 1), _
    TableName:="PivotTable1"
 
    'ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
 
    With ActiveSheet.PivotTables("PivotTable1")
        .NullString = "0"
        .SmallGrid = False
    End With
    ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:="DATA_STADIU", _
        ColumnFields:="MOTIV", PageFields:=Array("STADIU_DOSAR", "PRODUS")
 
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("procent")
        .Orientation = xlDataField
        .NumberFormat = "0.00%"
    End With
 
   ActiveSheet.PivotTables("PivotTable1").PivotFields("MOTIV").AutoShow _
        xlAutomatic, xlTop, 9, "Sum of procent"
 
        'Sheet1.Visible = xlSheetHidden
    ActiveSheet.Range("B5").Select
    Charts.Add
    ActiveChart.SetSourceData Source:=Sheets("Status").Range("B5")
    ActiveChart.Location Where:=xlLocationAsNewSheet
    ActiveChart.PivotLayout.PivotFields("PRODUS").CurrentPage = "Flexi Centralizat"
    ActiveChart.PivotLayout.PivotFields("STADIU_DOSAR").CurrentPage = "Respins"
 
    ActiveChart.Name = "Procente"
        'adauaga macro chart_calculate() in noul chart creat
        Dim LineNum As Long
    Dim strProcLine As String
    With ActiveWorkbook.VBProject.VBComponents(ActiveChart.CodeName).CodeModule
      ' adaugat procedura goala
'Here it stops
     .CreateEventProc "Calculate", "Chart"
    'MsgBox ok3
    strProcLine = "Format_Chart"
   ' MsgBox ok
    .InsertLines .ProcBodyLine("Chart_Calculate", 0) + 1, strProcLine
   ' MsgBox ok
    End With
   ' MsgBox ok
    Dim isrs As Integer
    ActiveChart.ChartType = xlLineMarkers
 
    For isrs = 1 To ActiveChart.SeriesCollection.Count
    ActiveChart.SeriesCollection(isrs).ApplyDataLabels
    ActiveChart.SeriesCollection(isrs).Smooth = True
    ActiveChart.SeriesCollection(isrs).Border.Weight = xlThin
    ActiveChart.SeriesCollection(isrs).MarkerSize = 5
    ActiveChart.Legend.Font.Size = 6
    ActiveChart.SeriesCollection(isrs).Border.ColorIndex = isrs
    ActiveChart.SeriesCollection(isrs).DataLabels.Font.FontStyle = "Bold"
    ActiveChart.SeriesCollection(isrs).DataLabels.Font.Size = 7
    Next
 
Sheet1.Activate
Dim wsd1 As Worksheet
Set wsd1 = Sheets.Add
    wsd1.Name = "Status1"
    For Each PT In wsd1.PivotTables
    PT.TableRange2.Clear
    Next PT
'pivot +chartul valori
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
    SourceData:="Sheet1!R1C1:R" & LastRow & "C" & LastColumn).CreatePivotTable TableDestination:=wsd1. _
        Cells(3, 1), _
    TableName:="PivotTable2"
 
    'ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
 
    With ActiveSheet.PivotTables("PivotTable2")
        .NullString = "0"
        .SmallGrid = False
    End With
    ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:="DATA_STADIU", _
        ColumnFields:="MOTIV", PageFields:=Array("STADIU_DOSAR", "PRODUS")
 
        With ActiveSheet.PivotTables("PivotTable2").PivotFields("NR motiv")
        .Orientation = xlDataField
        .NumberFormat = "0"
    End With
 
   ActiveSheet.PivotTables("PivotTable2").PivotFields("MOTIV").AutoShow _
        xlAutomatic, xlTop, 9, "Sum of NR motiv"
 
        'Sheet1.Visible = xlSheetHidden
    ActiveSheet.Range("B5").Select
    Charts.Add
    ActiveChart.SetSourceData Source:=Sheets("Status1").Range("B5")
    ActiveChart.Location Where:=xlLocationAsNewSheet
    ActiveChart.PivotLayout.PivotFields("PRODUS").CurrentPage = "Flexi Centralizat"
    ActiveChart.PivotLayout.PivotFields("STADIU_DOSAR").CurrentPage = "Respins"
    ActiveChart.Name = "Valori"
 
'adauaga macro chart_calculate() in noul chart creat
    Dim strProcLine1 As String
    With ActiveWorkbook.VBProject.VBComponents(ActiveChart.CodeName).CodeModule
    ' adaugat procedura goala
    .CreateEventProc "Calculate", "Chart"
    strProcLine1 = "Format_Chart"
     .InsertLines .ProcBodyLine("Chart_Calculate", 0) + 1, strProcLine1
 
    End With
    ActiveChart.ChartType = xlLineMarkers
 
    For isrs = 1 To ActiveChart.SeriesCollection.Count
    ActiveChart.SeriesCollection(isrs).ApplyDataLabels
    ActiveChart.SeriesCollection(isrs).Smooth = True
    ActiveChart.SeriesCollection(isrs).Border.Weight = xlThin
    ActiveChart.SeriesCollection(isrs).MarkerSize = 5
    ActiveChart.Legend.Font.Size = 6
    ActiveChart.SeriesCollection(isrs).Border.ColorIndex = isrs
    ActiveChart.SeriesCollection(isrs).DataLabels.Font.FontStyle = "Bold"
    ActiveChart.SeriesCollection(isrs).DataLabels.Font.Size = 7
    Next
 
ErrHandler:
    If Err.Number = 9 Then
        Resume Next
    End If
 
End Sub
Public Sub Format_chart()
Dim isrs As Integer
ActiveChart.ChartType = xlLineMarkers
For isrs = 1 To ActiveChart.SeriesCollection.Count
ActiveChart.SeriesCollection(isrs).ApplyDataLabels
ActiveChart.SeriesCollection(isrs).Smooth = True
ActiveChart.SeriesCollection(isrs).Border.Weight = xlThin
ActiveChart.SeriesCollection(isrs).MarkerSize = 5
ActiveChart.Legend.Font.Size = 6
ActiveChart.SeriesCollection(isrs).Border.ColorIndex = isrs
ActiveChart.SeriesCollection(isrs).DataLabels.Font.FontStyle = "Bold"
ActiveChart.SeriesCollection(isrs).DataLabels.Font.Size = 7
Next
End Sub

 

[Andrew Poulsom]

I don't know why your macro stops, but instead of creating a new event procedure in your code, have you considered manually putting some code in the Workbook_SheetCalculate event procedure in the ThisWorkbook module? You could check that the chart sheet exists using the SheetExists function here:

http://spreadsheetpage.com/index.php/tip/some_useful_vba_functions/

then pass the sheet as an argument to your Format_chart procedure.

 

[ety]

I don't know why your macro stops, but instead of creating a new event procedure in your code, have you considered manually putting some code in the Workbook_SheetCalculate event procedure in the ThisWorkbook module? You could check that the chart sheet exists using the SheetExists function here:

http://spreadsheetpage.com/index.php/tip/some_useful_vba_functions/

then pass the sheet as an argument to your Format_chart procedure.

Thank you for your answer Andrew. But i don't know if it solves my problem because:

• i''m trying to fully automatize a report, so the manually putting some code part falls
• Format_chart function is suposed to run everytime the pivot chart changes,(new filters are applyed to it) thus i have chosen Chart_Calculate() event.

A solution for this problem would be to create a blank template chart sheet and manually put there the code, and then when creating a chart, to use this template wich already has built the Calculate_Chart event.
Eventually i will do so, if no solution occurs, but i still want to figure this out.