thestormdrag
01-18-2013, 03:18 PM
Hi Everyone
I've got a bit of a weird problem - I've written some code to extract a trendline formula from a newly created graph and it works perfectly if, and only if, I step through it line by line. If I run the code it will sometimes return a null string instead of the formula - this is really annoying as I need to get the trendline formula from over 200 graphs in 200 files (that bit worked out with help from these forums).
During my troubleshooting, I've simplified and simplified the code in terms of functions being called and subroutines etc but even with just the below, it's still really flakey.
What I have is:
Sub draw_a_graph(graph_no As Integer, chart_type As String, new_title As String, trendlines As Boolean, first_row As Integer, last_row As Integer)
'***** this sub-routine adds a graph to the current sheet
On Error Goto ErrMsg 'this error handling isn't normally here, I just added it incase something odd was happening
'add the chart
With ActiveSheet.ChartObjects.Add(Left:=300, Width:=900, Top:=90 + graph_no * 250, Height:=225)
.Chart.ChartType = xlLine
.Chart.SetSourceData Source:=Range(Cells(first_row, 1), Cells(last_row, 3))
'set the chart title
.Chart.HasTitle = True
.Chart.ChartTitle.Text = new_title
'label the Y axis
.Chart.Axes(xlValue).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "% " & chart_type & Chr(13) & "use"
.Chart.SetElement (msoElementPrimaryValueAxisTitleHorizontal)
'set the Y scale and format
.Chart.Axes(xlValue, xlPrimary).MaximumScale = 100
.Chart.Axes(xlValue, xlPrimary).MinimumScale = 0
.Chart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0"
'label the series correctly
.Chart.SeriesCollection(1).Name = "=""Received (%)"""
.Chart.SeriesCollection(2).Name = "=""Sent (%)"""
'if required, add the trendlines
If trendlines Then
'add Received Trendline
.Chart.SeriesCollection(1).trendlines.Add
.Chart.SeriesCollection(1).trendlines(1).Format.Line.ForeColor.ObjectThemeC olor = msoThemeColorAccent1
'add Sent Trendline
.Chart.SeriesCollection(2).trendlines.Add
.Chart.SeriesCollection(2).trendlines(1).Format.Line.ForeColor.ObjectThemeC olor = msoThemeColorAccent2
'add formula for the trendline
ActiveSheet.Range("g2") = "RX Trend ="
ActiveSheet.Range("g3") = "TX Trend ="
.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = True
.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = True
ActiveSheet.Range("h2").Value = .Chart.SeriesCollection(1).trendlines(1).DataLabel.Text
ActiveSheet.Range("h3").Value = .Chart.SeriesCollection(2).trendlines(1).DataLabel.Text
.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = False
.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = False
End If
End With
Exit Sub
ErrMsg:
MsgBox ("Something's gone wrong somewhere")
End Sub
The graphs always get added, even if the formulas don't.
The headings in G2 and G3 always get added, even if the formulas don't.
I've tried outputting to a variable, instead of a cell value, and that doesn't always work.
I've tried outputting to a msgbox, instead of a cell value, and that doesn't always work.
The draw_a_graph sub-routine is called from
Sub run_VBA_code_on_all_excel_sheets_in_a_folder()
'*****this sub-routine will run specified code on every .XLSX file in a specified folder
Dim wbBook As Workbook
Dim default_path As String
Dim src_file As String
'********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
'********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
'turn off the screen etc for quicker processing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'set the default source directory
default_path = "C:\reports\" 'trailing \ is very important
'dir returns the first filname from the default path
src_file = Dir(default_path & "*.xlsx")
'change to the source directory
ChDir (default_path)
'loop while files to process
Do While src_file <> vbNullString
'open the file
Set wbBook = Workbooks.Open(src_file)
'**********************************************************
'do whatever you want per book below here
'**********************************************************
Call draw_a_graph(0, "bandwidth", "Router Graph", True, 7, 372)
wbBook.Close savechanges:=True 'close the file, saving changes
'**********************************************************
'do whatever you want per book above here
'**********************************************************
'get the next filename
src_file = Dir
Loop
'turn options back to normal
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
I have uploaded 5 of the files to be graphed 9416.
I'm running Excel 2010 on Windows 7.
I've searched all sorts of forums and help files and google and I just can't make heads or tails of what's happening - any thoughts gratefully accepted!
All the best
David
I've got a bit of a weird problem - I've written some code to extract a trendline formula from a newly created graph and it works perfectly if, and only if, I step through it line by line. If I run the code it will sometimes return a null string instead of the formula - this is really annoying as I need to get the trendline formula from over 200 graphs in 200 files (that bit worked out with help from these forums).
During my troubleshooting, I've simplified and simplified the code in terms of functions being called and subroutines etc but even with just the below, it's still really flakey.
What I have is:
Sub draw_a_graph(graph_no As Integer, chart_type As String, new_title As String, trendlines As Boolean, first_row As Integer, last_row As Integer)
'***** this sub-routine adds a graph to the current sheet
On Error Goto ErrMsg 'this error handling isn't normally here, I just added it incase something odd was happening
'add the chart
With ActiveSheet.ChartObjects.Add(Left:=300, Width:=900, Top:=90 + graph_no * 250, Height:=225)
.Chart.ChartType = xlLine
.Chart.SetSourceData Source:=Range(Cells(first_row, 1), Cells(last_row, 3))
'set the chart title
.Chart.HasTitle = True
.Chart.ChartTitle.Text = new_title
'label the Y axis
.Chart.Axes(xlValue).HasTitle = True
.Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "% " & chart_type & Chr(13) & "use"
.Chart.SetElement (msoElementPrimaryValueAxisTitleHorizontal)
'set the Y scale and format
.Chart.Axes(xlValue, xlPrimary).MaximumScale = 100
.Chart.Axes(xlValue, xlPrimary).MinimumScale = 0
.Chart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0"
'label the series correctly
.Chart.SeriesCollection(1).Name = "=""Received (%)"""
.Chart.SeriesCollection(2).Name = "=""Sent (%)"""
'if required, add the trendlines
If trendlines Then
'add Received Trendline
.Chart.SeriesCollection(1).trendlines.Add
.Chart.SeriesCollection(1).trendlines(1).Format.Line.ForeColor.ObjectThemeC olor = msoThemeColorAccent1
'add Sent Trendline
.Chart.SeriesCollection(2).trendlines.Add
.Chart.SeriesCollection(2).trendlines(1).Format.Line.ForeColor.ObjectThemeC olor = msoThemeColorAccent2
'add formula for the trendline
ActiveSheet.Range("g2") = "RX Trend ="
ActiveSheet.Range("g3") = "TX Trend ="
.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = True
.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = True
ActiveSheet.Range("h2").Value = .Chart.SeriesCollection(1).trendlines(1).DataLabel.Text
ActiveSheet.Range("h3").Value = .Chart.SeriesCollection(2).trendlines(1).DataLabel.Text
.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = False
.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = False
End If
End With
Exit Sub
ErrMsg:
MsgBox ("Something's gone wrong somewhere")
End Sub
The graphs always get added, even if the formulas don't.
The headings in G2 and G3 always get added, even if the formulas don't.
I've tried outputting to a variable, instead of a cell value, and that doesn't always work.
I've tried outputting to a msgbox, instead of a cell value, and that doesn't always work.
The draw_a_graph sub-routine is called from
Sub run_VBA_code_on_all_excel_sheets_in_a_folder()
'*****this sub-routine will run specified code on every .XLSX file in a specified folder
Dim wbBook As Workbook
Dim default_path As String
Dim src_file As String
'********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
'********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
'turn off the screen etc for quicker processing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'set the default source directory
default_path = "C:\reports\" 'trailing \ is very important
'dir returns the first filname from the default path
src_file = Dir(default_path & "*.xlsx")
'change to the source directory
ChDir (default_path)
'loop while files to process
Do While src_file <> vbNullString
'open the file
Set wbBook = Workbooks.Open(src_file)
'**********************************************************
'do whatever you want per book below here
'**********************************************************
Call draw_a_graph(0, "bandwidth", "Router Graph", True, 7, 372)
wbBook.Close savechanges:=True 'close the file, saving changes
'**********************************************************
'do whatever you want per book above here
'**********************************************************
'get the next filename
src_file = Dir
Loop
'turn options back to normal
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
I have uploaded 5 of the files to be graphed 9416.
I'm running Excel 2010 on Windows 7.
I've searched all sorts of forums and help files and google and I just can't make heads or tails of what's happening - any thoughts gratefully accepted!
All the best
David