VBA Snippets
Chart_Before
Public Function Chart_Before(ByVal oChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal sChartSize As String) As clsChartSettings
Const sPROCNAME As String = "Chart_Before"
Dim oBefore As New clsChartSettings
On Error GoTo ErrorHandler
oBefore.ChartWidth = modChart.Return_ChartWidth(sChartSize)
oBefore.ChartHeight = modChart.Return_ChartHeight(sChartSize)
oBefore.PlotAreaHeight = modChart.Return_PlotAreaHeight(sChartSize)
oBefore.PlotAreaWidth = modChart.Return_PlotAreaWidth(sChartSize)
If (oChart Is Nothing) Then
oBefore.WasThere = False
Set Chart_Before = oBefore
Exit Function
End If
oBefore.WasThere = True
oBefore.arSeriesAxes = Split(Axis_SeriesOrder(oChart), "~")
'-------------- primary
If oChart.Axes(xlValue, xlPrimary).HasTitle = True Then
oBefore.ChartTitle = oChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text
oBefore.ChartHasTitle = True
Else
oBefore.ChartHasTitle = False
End If
If (Available_TickLabels(oChart.Axes(xlValue, xlPrimary)) = True) Then
oBefore.Axis1LabelFormat = oChart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat
oBefore.Axis1Min = oChart.Axes(xlValue, xlPrimary).MinimumScale
oBefore.Axis1Max = oChart.Axes(xlValue, xlPrimary).MaximumScale
oBefore.Axis1MajorUnit = oChart.Axes(xlValue, xlPrimary).MajorUnit
End If
'-------------- x-axis
If oChart.Axes(xlCategory, xlPrimary).HasTitle = True Then
oBefore.ChartCategoryTitle = oChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text
oBefore.ChartHasCategoryTitle = True
Else
oBefore.ChartHasCategoryTitle = False
End If
If (Available_TickLabels(oChart.Axes(xlCategory, xlPrimary)) = True) Then
oBefore.Axis2LabelFormat = oChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat
If (Available_AxisPrimaryCategoryType(oChart) = True) Then
oBefore.Axis2CategoryType = oChart.Axes(xlCategory, xlPrimary).CategoryType
If (oBefore.Axis2CategoryType = Excel.XlCategoryType.xlAutomaticScale) Then
If (oChart.Axes(xlCategory, xlPrimary).MajorUnit > 0) Then
oBefore.Axis2CategoryType = Excel.XlCategoryType.xlTimeScale
Else
oBefore.Axis2CategoryType = Excel.XlCategoryType.xlCategoryScale
End If
End If
If (oBefore.Axis2CategoryType = Excel.XlCategoryType.xlTimeScale) Then
oBefore.Axis2Min = oChart.Axes(xlCategory, xlPrimary).MinimumScale
oBefore.Axis2Max = oChart.Axes(xlCategory, xlPrimary).MaximumScale
oBefore.Axis2MajorUnit = oChart.Axes(xlCategory, xlPrimary).MajorUnit
oBefore.Axis2BaseUnit = oChart.Axes(xlCategory, xlPrimary).BaseUnit
End If
If (oBefore.Axis2CategoryType = Excel.XlCategoryType.xlCategoryScale) Then
oBefore.Axis2LabelSp = oChart.Axes(xlCategory, xlPrimary).TickLabelSpacing
oBefore.Axis2MarkSp = oChart.Axes(xlCategory, xlPrimary).TickMarkSpacing
oBefore.Axis2Between = oChart.Axes(xlCategory, xlPrimary).AxisBetweenCategories
oBefore.Axis2NumCats = UBound(oChart.Axes(xlCategory, xlPrimary).CategoryNames)
End If
End If
End If
If (enChartType <> Pie) Then
'-------------- 2nd value axis
If modChart.Available_AxisSecondary(oChart, xlValue) = True Then
If oChart.Axes(xlValue, xlSecondary).HasTitle = True Then
oBefore.ChartSecondaryTitle = oChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text
oBefore.ChartHasSecondaryTitle = True
Else
oBefore.ChartHasSecondaryTitle = False
End If
If (Available_TickLabels(oChart.Axes(xlCategory, xlSecondary)) = True) Then
oBefore.Axis3LabelFormat = oChart.Axes(xlValue, xlSecondary).TickLabels.NumberFormat
oBefore.Axis3Min = oChart.Axes(xlValue, xlSecondary).MinimumScale
oBefore.Axis3Max = oChart.Axes(xlValue, xlSecondary).MaximumScale
oBefore.Axis3MajorUnit = oChart.Axes(xlValue, xlSecondary).MajorUnit
'-------------- 2nd category axis
If oChart.Axes(xlCategory, xlSecondary).CategoryType <> xlCategoryScale Then
oBefore.Axis4LabelFormat = oChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat
oBefore.Axis4Min = oChart.Axes(xlCategory, xlSecondary).MinimumScale
oBefore.Axis4Max = oChart.Axes(xlCategory, xlSecondary).MaximumScale
oBefore.Axis4MajorUnit = oChart.Axes(xlCategory, xlSecondary).MajorUnit
oBefore.Axis2CategoryType = oChart.Axes(xlCategory, xlSecondary).CategoryType
If (oBefore.Axis2CategoryType = Excel.XlCategoryType.xlAutomaticScale) Then
If (oChart.Axes(xlCategory, xlSecondary).MajorUnit > 0) Then
oBefore.Axis2CategoryType = Excel.XlCategoryType.xlTimeScale
Else
oBefore.Axis2CategoryType = Excel.XlCategoryType.xlCategoryScale
End If
End If
End If
End If
End If
End If
Set Chart_Before = oBefore
Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function
Chart_CopyPasteFormat
Public Sub Chart_CopyPasteFormat(ByVal objChart As Excel.Chart, _
ByVal swshname As String)
Dim objChart2 As Excel.Chart
Dim objChartToCopy As Excel.Chart
Dim objChartObject As Excel.ChartObject
On Error GoTo AnError
Set objChartToCopy = ThisWorkbook.Charts(swshname)
'Set objChartToCopy = ThisWorkbook.Sheets(sWshName)
objChartToCopy.ChartArea.Copy
Set objChartObject = objChart.Parent
objChartObject.Select
If Application.Version = "12.0" Then
ActiveSheet.PasteSpecial Format:=2
End If
If Application.Version = "11.0" Then
objChartObject.Chart.Paste Type:=xlFormats
End If
Set objChart2 = objChartObject.Chart
If Application.Version = "12.0" Then
objChart2.ChartArea.Select
End If
If Application.Version = "11.0" Then
objChartObject.Activate
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Chart_CopyPasteFormat", Err)
End Sub
Chart_Format
Public Sub Chart_Format(ByVal bCreateChart As Boolean, _
ByVal objBefore As clsChartSettings, _
ByVal enChartType As g_enChartTypeList, _
ByVal schartsize As String, _
ByVal sPlotBy As String, _
ByVal bIncludeDataLabels As Boolean, _
ByVal bIncludeGridlines As Boolean, _
ByVal bIncludeYAxisTitles As Boolean, _
ByVal bIncludeXAxisTitle As Boolean, _
ByVal bIncludeLegend As Boolean, _
ByVal bIncludeTrendline As Boolean, _
ByVal bInclude2ndY As Boolean, _
ByVal bOptionsCopyOriginal As Boolean, _
ByVal bOptionsRetainLabelFormat As Boolean, _
ByVal bOptionsRetainScaleFormat As Boolean, _
ByVal bOptionsScatterDates As Boolean, _
ByVal bOptionsRemoveColumnBorders As Boolean, _
ByVal iNoOfIntervals As Integer)
On Error GoTo AnError
If (sPlotBy = "Rows") Then ActiveChart.PlotBy = XlRowCol.xlRows
If (sPlotBy = "Columns") Then ActiveChart.PlotBy = XlRowCol.xlColumns
Call Format_ChartType(ActiveChart, enChartType)
If enChartType = Basic_Line Or _
enChartType = Basic_Line_w_Markers Or _
enChartType = Basic_Line_CategoryScale Or _
enChartType = Scatter_Line_w_Markers Or _
enChartType = Scatter_Line Then
If (objBefore.WasThere = True) Then
Call Format_SeriesReAssign(ActiveChart, _
objBefore, _
bInclude2ndY)
End If
End If
Call Format_ChartArea(ActiveChart, _
objBefore.ChartWidth, _
objBefore.ChartHeight)
Call Format_PlotArea(ActiveChart, _
enChartType, _
objBefore.PlotAreaWidth, _
objBefore.PlotAreaHeight)
Call Format_Legend(ActiveChart, _
enChartType, _
bIncludeLegend)
Call Format_TickLabels(ActiveChart, _
enChartType)
Call Format_DataLabels(ActiveChart, _
enChartType, _
bIncludeDataLabels)
Call Format_Gridlines(ActiveChart, _
enChartType, _
bIncludeGridlines)
Call Format_Trendlines(ActiveChart, _
enChartType, _
bIncludeTrendline)
If (enChartType = Pie) Then
Call Format_Pie(ActiveChart, schartsize)
End If
If (enChartType = Scatter_Line) Or _
(enChartType = Scatter_Line_w_Markers) Or _
(enChartType = Combo_Column_ScatterLine) Or _
(enChartType = Combo_Column_Line2) Or _
(enChartType = Combo_Column_ScatterLine) Then
Call Format_AxesScatter(ActiveChart, _
enChartType, _
objBefore, _
iNoOfIntervals, _
bOptionsRetainScaleFormat, _
bOptionsScatterDates)
End If
If (bOptionsRetainScaleFormat = True) And _
(bCreateChart = False) Then
Call Format_AxesPrimary(ActiveChart, _
objBefore, _
iNoOfIntervals)
Call Format_AxesSecondary(ActiveChart, _
objBefore)
End If
'Go to Axis title routine
Call Format_AxisTitle(ActiveChart, _
objBefore, _
enChartType, _
bIncludeYAxisTitles, _
bIncludeXAxisTitle)
If (bOptionsRetainScaleFormat = True) And _
(bCreateChart = False) Then
Call Format_AxisLabelFormats(ActiveChart, _
objBefore)
End If
If (bOptionsRemoveColumnBorders = False) Then
Call Format_LineStylesRemove(ActiveChart)
End If
Call Format_ReApplySettings(ActiveChart, _
objBefore)
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Chart_Format", Err)
End Sub
Chart_InOne
Returns a boolean indicating if the current selection is inside a chart.Public Function Chart_InOne() As Boolean
On Error GoTo AnError
If Chart_ObjectValid(TypeName(Application.Selection)) = True Then
Chart_InOne = True
Else
Chart_InOne = False
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_InOne", Err)
End Function
Chart_Insert
Public Function Chart_Insert(ByVal dbChartWidth As Double, _
ByVal dbChartHeight As Double) _
As Excel.Chart
Dim objChartObject As ChartObject
On Error GoTo AnError
Set objChartObject = ActiveSheet.ChartObjects.Add(Application.ActiveCell.Left, _
Application.ActiveCell.Top, _
dbChartWidth, _
dbChartHeight)
objChartObject.Placement = xlMove
objChartObject.Select
Set Chart_Insert = objChartObject.Chart
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_Insert", Err)
End Function
Chart_ObjectValid
Public Function Chart_ObjectValid(ByVal sObjectName As String) As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Chart_ObjectValid")
Select Case sObjectName
Case "Axis": Chart_ObjectValid = True
Case "AxisTitle": Chart_ObjectValid = True
Case "ChartArea": Chart_ObjectValid = True
Case "ChartTitle": Chart_ObjectValid = True
Case "Corners": Chart_ObjectValid = True
Case "DataTable": Chart_ObjectValid = True
Case "DataLabels": Chart_ObjectValid = True
Case "ErrorBars": Chart_ObjectValid = True
Case "Floor": Chart_ObjectValid = True
Case "Gridlines": Chart_ObjectValid = True
Case "Legend": Chart_ObjectValid = True
Case "PlotArea": Chart_ObjectValid = True
Case "Point": Chart_ObjectValid = True
Case "Series": Chart_ObjectValid = True
Case "Walls": Chart_ObjectValid = True
Case Else
If (sObjectName <> "Range") Then
Call MsgBox(sObjectName & " - Chart_ObjectValid")
End If
Chart_ObjectValid = False
End Select
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_ObjectValid", Err)
End Function
Chart_SeriesOrderReturn
Public Function Axis_SeriesOrder(ByVal objChart As Chart) As String
Dim mySeries As Series
Dim myAxisGroup As XlAxisGroup
On Error GoTo AnError
For Each mySeries In objChart.SeriesCollection
myAxisGroup = mySeries.AxisGroup
Axis_SeriesOrder = Axis_SeriesOrder & myAxisGroup & "~"
Next mySeries
Axis_SeriesOrder = Left(Axis_SeriesOrder, Len(Axis_SeriesOrder) - 1)
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Axis_SeriesOrder", Err)
End Function
Chart_SeriesReAssign
Public Sub Format_SeriesReAssign(ByVal objChart As Excel.Chart, _
ByVal objBefore As clsChartSettings, _
ByVal bInclude2ndY As Boolean)
Dim iseriescount As Integer
Dim iaxescount As Integer
Dim myAxisGroup As Integer
On Error GoTo AnError
If (objChart.SeriesCollection.Count > 1) And _
bInclude2ndY = True Then
For iseriescount = 2 To objChart.SeriesCollection.Count
objChart.SeriesCollection(iseriescount).AxisGroup = 2
Next iseriescount
If modChart.Available_AxisSecondary(objChart, xlValue) = True Then
objChart.Axes(xlValue, xlSecondary).MajorTickMark = xlTickMarkOutside
End If
Else
For iaxescount = 0 To UBound(objBefore.arSeriesAxes)
Select Case objBefore.arSeriesAxes(iaxescount)
Case 1:
myAxisGroup = 1
Case 2:
myAxisGroup = 2
End Select
objChart.SeriesCollection(iaxescount + 1).AxisGroup = myAxisGroup
Next iaxescount
If modChart.Available_AxisSecondary(objChart, xlValue) = True Then
With objChart.Axes(xlValue, xlSecondary)
.MajorTickMark = xlTickMarkOutside
End With
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_SeriesReAssign", Err)
End Sub
Chart_SeriesReColour
Public Sub Format_SeriesReColour(ByVal objChart As Excel.Chart)
Dim iseriescount As Integer
Dim objSeries As Excel.Series
Dim lcolour As Long
On Error GoTo AnError
For iseriescount = 1 To objChart.SeriesCollection.Count
Set objSeries = objChart.SeriesCollection(iseriescount)
Select Case iseriescount
Case 1, 9, 17: lcolour = RGB(10, 48, 102)
Case 2, 10, 18: lcolour = RGB(0, 174, 239)
Case 3, 11, 19: lcolour = RGB(180, 200, 205)
Case 4, 12, 20: lcolour = RGB(148, 156, 161)
Case 5, 13, 21: lcolour = RGB(69, 85, 96)
Case 6, 14, 22: lcolour = RGB(77, 148, 185)
Case 7, 15, 23: lcolour = RGB(131, 163, 175)
Case 8, 16, 24: lcolour = RGB(128, 128, 128)
End Select
objSeries.Interior.Color = lcolour
Next iseriescount
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_SeriesReColour", Err)
End Sub
Chart_Size
Public Sub Chart_Size(ByVal objChart As Excel.Chart, _
ByVal bCopyOriginal As Boolean, _
ByVal dbChartWidth As Double, _
ByVal dbChartHeight As Double)
On Error GoTo AnError
' copy original to clipboard, if requested by user
If bCopyOriginal = True Then
objChart.Parent.Copy
End If
With objChart.Parent
.Width = dbChartWidth
.Height = dbChartHeight
End With
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Chart_Size", Err)
End Sub
Chart_TypeIdentify
Public Function Chart_TypeIdentify(ByVal objChart As Excel.Chart) As String
Dim sreturn As String
Dim iseriescount As Integer
Dim objSeries As Excel.Series
Dim objChartType As Excel.XlChartType
Dim bdifferenttypes As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Chart_TypeIdentify")
If (objChart.SeriesCollection.Count > 0) Then
Set objSeries = objChart.SeriesCollection(1)
objChartType = objSeries.ChartType
bdifferenttypes = False
For iseriescount = 1 To objChart.SeriesCollection.Count
If (Available_SeriesCollection(objChart, iseriescount) = True) Then
Set objSeries = objChart.SeriesCollection(iseriescount)
If (objSeries.ChartType <> objChartType) Then
bdifferenttypes = True
End If
End If
Next iseriescount
If (bdifferenttypes = False) Then
Select Case objChartType
Case Excel.XlChartType.xlAreaStacked: sreturn = "Area"
Case Excel.XlChartType.xlBarClustered: sreturn = "Bar"
Case Excel.XlChartType.xlBarStacked: sreturn = "Bar Stacked"
Case Excel.XlChartType.xlColumnClustered: sreturn = "Column"
Case Excel.XlChartType.xlColumnStacked: sreturn = "Column Stacked"
Case Excel.XlChartType.xlLine: sreturn = "Line"
Case Excel.XlChartType.xlLineMarkers: sreturn = "Line with Markers"
Case Excel.XlChartType.xlPie: sreturn = "Pie"
Case Excel.XlChartType.xlXYScatterLinesNoMarkers: sreturn = "Scatter Line"
Case Excel.XlChartType.xlXYScatterSmoothNoMarkers: sreturn = "Scatter Line"
Case Excel.XlChartType.xlXYScatterLines: sreturn = "Scatter Line with Markers"
Case Excel.XlChartType.xlXYScatterSmooth: sreturn = "Scatter Line with Markers"
Case Excel.XlChartType.xlStockHLC: sreturn = "Stock"
Case Excel.XlChartType.xlStockOHLC: sreturn = "Stock"
Case Excel.XlChartType.xlStockVHLC: sreturn = "Stock"
Case Excel.XlChartType.xlStockVOHLC: sreturn = "Stock"
Case Excel.XlChartType.xlXYScatter: sreturn = "XY Scatter"
Case Else
End Select
Else
For iseriescount = 1 To objChart.SeriesCollection.Count
If (Available_SeriesCollection(objChart, iseriescount) = True) Then
Set objSeries = objChart.SeriesCollection(iseriescount)
If (objSeries.ChartType = xlXYScatter) Then
Chart_TypeIdentify = "XY Scatter"
Exit Function
End If
If (objSeries.ChartType = xlXYScatterLinesNoMarkers Or _
objSeries.ChartType = xlXYScatterSmoothNoMarkers) Then
Chart_TypeIdentify = "Scatter Line"
Exit Function
Else
sreturn = "different"
End If
If (objSeries.ChartType = xlXYScatterLines Or _
objSeries.ChartType = xlXYScatterSmooth) Then
Chart_TypeIdentify = "Scatter Line with Markers"
Exit Function
Else
sreturn = "different"
End If
If (objSeries.ChartType = xlLine Or _
objSeries.ChartType = xlLineMarkers) Then
Chart_TypeIdentify = "Stock"
Exit Function
Else
sreturn = "different"
End If
End If
Next iseriescount
End If
If (sreturn = "different") Then
Call MsgBox("Chart Type cannot be identified ...")
End If
End If
Chart_TypeIdentify = sreturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_TypeIdentify", Err)
End Function
Chart_TypeToEnumeration
Public Function Chart_TypeStringToEnumeration(ByVal scharttype As String) As g_enChartTypeList
Dim enReturn As g_enChartTypeList
On Error GoTo AnError
Select Case scharttype
Case "Area": enReturn = Area
Case "Bar": enReturn = Bar
Case "Basic Line"
If (modChart.Chart_InOne() = True) Then
If ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale Then
enReturn = Basic_Line_CategoryScale
Else
enReturn = Basic_Line
End If
Else
enReturn = Basic_Line
End If
Case "Basic Line w/ Markers": enReturn = Basic_Line_w_Markers
Case "Column": enReturn = Column
Case "Column Stacked": enReturn = Column_Stacked
Case "Pie": enReturn = Pie
Case "Stock": enReturn = Stock
Case "Scatter Line": enReturn = Scatter_Line
Case "Scatter Line w/ Markers": enReturn = Scatter_Line_w_Markers
Case "XY Scatter": enReturn = XY_Scatter
Case "Combo: Basic Line/Columns": enReturn = Combo_Column_Line
Case "Combo: Column/Basic Lines": enReturn = Combo_Column_Line2
Case "Combo: Price/Volume": enReturn = Combo_PriceVolume
Case "Combo: Column/Scatter Line": enReturn = Combo_Column_ScatterLine
Case "Combo: Stacked Col/Line": enReturn = Combo_Column_StackedLine
Case "Combo: 2 Lines(Basic)/Column": enReturn = Combo_2Lines_BasicColumn
Case "Combo: 2 Lines(Scatter)/Column": enReturn = Combo_2Lines_ScatterColumn
End Select
Chart_TypeStringToEnumeration = enReturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_TypeStringToEnumeration", Err)
End Function
ChartAxis_Category_TypeModified
Public Function ChartAxis_Category_TypeModified(ByVal objChart As Excel.Chart) As XlCategoryType
Dim sseries_xvalues As String
Dim swshname As String
Dim srange As String
Dim rgecompleterange As Range
Dim icount As Integer
Dim scellvalue As String
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_CategoryTypeModified")
sseries_xvalues = ChartSeries_FormulaXValuesGet(objChart.SeriesCollection(1), False)
'this can be blank for a scatter chart ?
If (Len(sseries_xvalues) > 0) Then
swshname = CellRef_ReturnComponent(sseries_xvalues, "Worksheet")
srange = CellRef_ReturnComponent(sseries_xvalues, "Range")
If (rgecompleterange Is Nothing) Then
Set rgecompleterange = Sheets(swshname).Range(srange)
Else
Set rgecompleterange = Application.Union(rgecompleterange, Sheets(swshname).Range(srange))
End If
For icount = 1 To rgecompleterange.Cells.Count
scellvalue = rgecompleterange.Cells(icount).Value
If modGeneral.Date_Valid(scellvalue) = False Then
Axis_CategoryTypeModified = xlCategoryScale
Exit Function
End If
Next icount
Axis_CategoryTypeModified = xlTimeScale
Exit Function
End If
Axis_CategoryTypeModified = xlAutomaticScale
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Axis_CategoryTypeModified", Err)
End Function
ChartAxis_Category_TypeReturn
Public Function ChartAxis_CategoryTypeReturn(ByVal objAxis As Axis) As XlCategoryType
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_CategoryTypeReturn")
Select Case objAxis.CategoryType
Case xlCategoryScale
Axis_CategoryTypeReturn = xlCategoryScale
Case xlTimeScale
Axis_CategoryTypeReturn = xlTimeScale
Case xlAutomaticScale
If objAxis.MajorUnit > 0 Then
Axis_CategoryTypeReturn = xlTimeScale
Else
Axis_CategoryTypeReturn = xlCategoryScale
End If
End Select
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Axis_CategoryTypeReturn", Err)
End Function
ChartAxis_Format
Public Sub ChartAxis_Format(ByVal objChart As Excel.Chart)
'line styles remove
Dim myChartSeries As New ChartSeries
Dim objRange As Range
Dim xAxisDataCount As Double
Dim seriesCount As Double
Dim relevantSeriesCount As Double
Dim i As Integer
Dim myChartType As XlChartType
On Error GoTo AnError
With myChartSeries
.Chart = objChart
.ChartSeries = 1
Set objRange = .XValues
xAxisDataCount = objRange.Count
seriesCount = objChart.SeriesCollection.Count
End With
For i = 1 To seriesCount
myChartType = objChart.SeriesCollection(i).ChartType
If myChartType = xlColumnClustered Or _
xlBarClustered Or _
xlColumnStacked Or _
xlBarStacked Then
relevantSeriesCount = relevantSeriesCount + 1
End If
Next i
If relevantSeriesCount * xAxisDataCount > 5 Then
For i = 1 To seriesCount
myChartType = objChart.SeriesCollection(i).ChartType
If myChartType = xlColumnClustered Or _
xlBarClustered Or _
xlColumnStacked Or _
xlBarStacked Then
objChart.SeriesCollection(i).Border.LineStyle = xlLineStyleNone
End If
Next i
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_LineStylesRemove", Err)
End Sub
Private Sub Format_AxesLine(ByVal objChart As Excel.Chart, _
ByVal objBefore As clsChartSettings)
Dim myRangeCount As Single
Dim myStartDate As Single
Dim myEndDate As Single
Dim myDivisor As Long
Dim myChartSeries As New ChartSeries
Dim myAxes As Axes
On Error GoTo AnError
With myChartSeries
.Chart = objChart
.ChartSeries = 1
' Establish start and end points for x axis (scatter)
myRangeCount = .XValues.Count
myEndDate = .XValues(myRangeCount).Value
myStartDate = .XValues(1).Value
End With
Set myAxes = objChart.Axes
With objChart.Axes(xlCategory, xlPrimary)
If isDateFormat(objBefore.Axis2LabelFormat) Then
.CategoryType = xlTimeScale
.BaseUnit = objBefore.Axis2BaseUnit
'do more date formatting here
Else
.CategoryType = xlCategoryScale
.TickLabelSpacing = CInt(objBefore.Axis2MajorUnit)
.TickMarkSpacing = CInt(objBefore.Axis2MajorUnit)
End If
End With
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_AxesLine", Err)
End Sub
ChartAxis_Format_CategoryPrimary
Public Sub ChartAxis_CategoryFormat_Primary(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal objBefore As clsChartSettings, _
ByVal iNoOfIntervals As Integer, _
ByVal bIncludeXAxisTitle As Boolean)
Dim currentaxistype As XlCategoryType
Dim newaxistype As XlCategoryType
Dim objAxis As Excel.Axis
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_CategoryFormat_Primary")
If (Chart_IsPie(objChart) = True) Then
Exit Sub
End If
Call Axis_TitleFormat(objChart, enChartType, bIncludeXAxisTitle, xlCategory, xlPrimary)
currentaxistype = Axis_CategoryTypeReturn(objChart.Axes(xlCategory, xlPrimary))
newaxistype = Format_AxesPrimaryAxisType(objChart)
' If Chart_IsScatter(objChart) = True Then
'
' objChart.Axes(xlCategory, xlPrimary).CategoryType = currentaxistype
'
' If modChart.Available_AxisPrimary(objChart, xlCategory) = True And _
' objBefore.Axis4LabelFormat = "" Then
'
'
'
' Else
' If (objBefore.Axis4Min > 0) Then objChart.Axes(xlCategory, xlPrimary).MinimumScale = objBefore.Axis4Min
' If (objBefore.Axis4Max > 0) Then objChart.Axes(xlCategory, xlPrimary).MaximumScale = objBefore.Axis4Max
' If (objBefore.Axis4MajorUnit > 0) Then objChart.Axes(xlCategory, xlPrimary).MajorUnit = objBefore.Axis4MajorUnit
' End If
' Exit Sub
' End If
If currentaxistype = xlTimeScale Then
' for scatter category axis becoming basic line
If newaxistype = xlCategoryScale Then
objChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "General"
Else
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "dd-mmm-yy"
If (objBefore.Axis2MajorUnit > 0) Then
objChart.Axes(xlCategory, xlPrimary).TickLabelSpacing = CInt(objBefore.Axis2MajorUnit)
objChart.Axes(xlCategory, xlPrimary).TickMarkSpacing = CInt(objBefore.Axis2MajorUnit)
End If
End If
End If
If currentaxistype = xlCategoryScale Then
If newaxistype = xlTimeScale Then
objChart.Axes(xlCategory, xlPrimary).CategoryType = xlTimeScale
objChart.Axes(xlCategory, xlPrimary).BaseUnit = objBefore.Axis2BaseUnit
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "dd-mmm-yy"
Else
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "General"
objChart.Axes(xlCategory, xlPrimary).TickLabelSpacing = 1
objChart.Axes(xlCategory, xlPrimary).TickMarkSpacing = 1
If (objBefore.Axis2LabelSp > 0) Then objChart.Axes(xlCategory, xlPrimary).TickLabelSpacing = objBefore.Axis2LabelSp
If (objBefore.Axis2MarkSp > 0) Then objChart.Axes(xlCategory, xlPrimary).TickMarkSpacing = objBefore.Axis2MarkSp
If (objBefore.Axis2Between > 0) Then objChart.Axes(xlCategory, xlPrimary).AxisBetweenCategories = objBefore.Axis2Between
End If
End If
If currentaxistype = xlAutomaticScale Then
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "General"
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_CategoryFormat_Primary", Err)
End Sub
ChartAxis_Format_CategorySecondary
Public Sub ChartAxis_CategoryFormat_Secondary(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal objBefore As clsChartSettings, _
ByVal bIncludeYAxisTitle As Boolean)
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_CategoryFormat_Secondary")
If (Chart_IsPie(objChart) = True) Then
Exit Sub
End If
Call Axis_TitleFormat(objChart, enChartType, bIncludeYAxisTitle, xlCategory, xlSecondary)
If modChart.Available_AxisSecondary(objChart, xlValue) = True Then
If objBefore.Axis3MajorUnit <> 0 Then
objChart.Axes(xlValue, xlSecondary).MinimumScale = objBefore.Axis3Min
objChart.Axes(xlValue, xlSecondary).MaximumScale = objBefore.Axis3Max
objChart.Axes(xlValue, xlSecondary).MajorUnit = objBefore.Axis3MajorUnit
Else
objChart.Axes(xlValue, xlSecondary).Delete
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_CategoryFormat_Secondary", Err)
End Sub
ChartAxis_Format_TickLabels
Public Sub ChartAxis_Format_TickLabels(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList)
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Format_TickLabels")
If (enChartType = eCombo_PriceVolume) Or _
(enChartType = eCombo_Columns_ScatterLine) Or _
(enChartType = eCombo_Columns_2BasicLines) Then
objChart.Axes(xlValue, xlPrimary).TickLabelPosition = xlHigh
objChart.Axes(xlCategory, xlPrimary).TickLabelPosition = xlNone
Else
If (enChartType <> ePie) Then
objChart.Axes(xlValue, xlPrimary).TickLabelPosition = xlLow
objChart.Axes(xlCategory, xlPrimary).TickLabelPosition = xlLow
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_TickLabels", Err)
End Sub
Public Sub Format_AxisLabelFormats(ByVal objChart As Excel.Chart, _
ByVal objBefore As clsChartSettings)
On Error GoTo AnError
objChart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat
If objBefore.Axis4LabelFormat <> "" And _
modChart.Available_AxisSecondary(objChart, xlValue) = True Then
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = objBefore.Axis4LabelFormat
Else
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = objBefore.Axis2LabelFormat
End If
If modChart.Available_AxisSecondary(objChart, xlValue) = True Then
objChart.Axes(xlValue, xlSecondary).TickLabels.NumberFormat = objBefore.Axis3LabelFormat
End If
If modChart.Available_AxisSecondary(objChart, xlCategory) = True Then
If Not objChart.Axes(xlCategory, xlSecondary).CategoryType = xlCategoryScale Then
If objBefore.Axis4LabelFormat <> "" Then
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = objBefore.Axis4LabelFormat
Else
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = objBefore.Axis2LabelFormat
End If
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_AxisLabelFormats", Err)
End Sub
ChartAxis_Format_Title
Public Sub ChartAxis_Format_Title(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal bIncludeAxis As Boolean, _
ByVal enAxisType As XlAxisType, _
ByVal enAxisGroup As XlAxisGroup, _
Optional ByVal sAxisTitle As String = "")
Dim objAxis As Excel.Axis
On Error GoTo AnError
If (objChart.HasAxis(enAxisType, enAxisGroup) = False) Then Exit Sub
Set objAxis = objChart.Axes(enAxisType, enAxisGroup)
' If (enChartType = eBar Or _
' enChartType = eBar_Stacked) Then
' If enAxisType = xlCategory Then enAxisType = xlValue
' If enAxisType = xlValue Then enAxisType = xlCategory
' End If
If (Len(sAxisTitle) = 0) Then sAxisTitle = "Axis Title"
If (bIncludeAxis = True) Then
If (objAxis.HasTitle = False) Then
objAxis.HasTitle = True
'objAxis.AxisTitle.Text = "Axis Title"
'objAxis.AxisTitle.Caption = "Axis Title"
objAxis.AxisTitle.Characters.Text = sAxisTitle
End If
Else
If (objAxis.HasTitle = True) Then
objAxis.HasTitle = False
End If
End If
'The AxisTitle object does not exist unless the HasTitle property is set to True
If (objAxis.HasTitle = True) Then
With objAxis.AxisTitle
.Orientation = xlHorizontal
If (enAxisType = xlValue) And (enAxisGroup = xlPrimary) Then
If (enChartType = eBar Or _
enChartType = eBar_Stacked) Then
Call Axis_TitleFormatHorizontal(objChart, objAxis)
Else
Call Axis_TitleFormatVertical(objChart, objAxis)
End If
End If
If (enAxisType = xlCategory) And (enAxisGroup = xlPrimary) Then
.HorizontalAlignment = xlCenter
If (enChartType = eBar Or _
enChartType = eBar_Stacked) Then
Call Axis_TitleFormatVertical(objChart, objAxis)
Else
Call Axis_TitleFormatHorizontal(objChart, objAxis)
End If
End If
.Font.Bold = False
'.Fill =
'.AutoScaleFont = False
'.Characters.Font
'.Font
'.Interior
'.VerticalAlignment
'.Orientation
'.Name
'.Shadow
'.Left
'.Top
'.Border
End With
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_TitleFormat", Err)
End Sub
ChartAxis_Format_TitleHorizontal
Public Sub ChartAxis_Format_TitleHorizontal(ByVal objChart As Excel.Chart, _
ByVal objAxis As Excel.Axis)
On Error GoTo AnError
'need to detect if a legend is being disabled ??
With objAxis.AxisTitle
objChart.PlotArea.Height = objChart.ChartArea.Height - 15
objChart.PlotArea.Width = objChart.ChartArea.Width - 10
.Top = objChart.ChartArea.Height - 10
End With
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_TitleFormatHorizontal", Err)
End Sub
ChartAxis_Format_TitleVertical
Public Sub ChartAxis_Format_TitleVertical(ByVal objChart As Excel.Chart, _
ByVal objAxis As Excel.Axis)
On Error GoTo AnError
With objAxis.AxisTitle
If (.Left > 0) Then .Left = 0
objChart.PlotArea.Left = 0
objChart.PlotArea.Width = objChart.ChartArea.Width
objChart.PlotArea.Height = objChart.ChartArea.Height
objChart.PlotArea.Height = objChart.PlotArea.Height - 15
objChart.PlotArea.Top = 15
.Top = 0
End With
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_TitleFormatVertical", Err)
End Sub
ChartAxis_Format_ValuesPrimary
Public Sub ChartAxis_Values_FormatPrimary(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal objBefore As clsChartSettings, _
ByVal iNoOfIntervals As Integer, _
ByVal bIncludeYAxisTitle As Boolean)
Dim originalAxisType As XlCategoryType
On Error GoTo AnError
originalAxisType = Chart_AxisCategoryType(objChart.Axes(xlCategory, xlPrimary))
' With objChart.Axes(xlValue, xlPrimary)
' .MinimumScale = GEMaxis1Min
' .MaximumScale = GEMaxis1Max
' .MajorUnit = GEMaxis1MajorUnit
' End With
If originalAxisType = xlTimeScale Then
If Axis_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
objChart.Axes(xlCategory, xlPrimary).CategoryType = originalAxisType
If modChart.Available_AxisPrimary(objChart, xlCategory) = True And _
objBefore.Axis4LabelFormat = "" Then
objChart.Axes(xlCategory, xlPrimary).MinimumScale = objChart.Axes(xlCategory, xlPrimary).MinimumScale
objChart.Axes(xlCategory, xlPrimary).MaximumScale = objChart.Axes(xlCategory, xlPrimary).MaximumScale
objChart.Axes(xlCategory, xlPrimary).MajorUnit = objChart.Axes(xlCategory, xlPrimary).MajorUnit
Else
objChart.Axes(xlCategory, xlPrimary).MinimumScale = objBefore.Axis4Min
objChart.Axes(xlCategory, xlPrimary).MaximumScale = objBefore.Axis4Max
objChart.Axes(xlCategory, xlPrimary).MajorUnit = objBefore.Axis4MajorUnit
End If
Else
' for scatter category axis becoming basic line
Call Format_AxesLine(objChart, _
objBefore)
End If
End If
If originalAxisType = xlCategoryScale Then
If Not Axis_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
objChart.Axes(xlCategory, xlPrimary).CategoryType = originalAxisType
If modChart.Available_AxisPrimary(objChart, xlCategory) = True And _
objBefore.Axis4LabelFormat = "" Then
objChart.Axes(xlCategory, xlPrimary).TickLabelSpacing = objBefore.Axis2LabelSp
objChart.Axes(xlCategory, xlPrimary).TickMarkSpacing = objBefore.Axis2MarkSp
objChart.Axes(xlCategory, xlPrimary).AxisBetweenCategories = objBefore.Axis2Between
End If
End If
End If
If (Chart_IsPie(objChart) = True) Then
Exit Sub
End If
Call Axis_TitleFormat(objChart, enChartType, bIncludeYAxisTitle, xlValue, xlPrimary)
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_ValuesFormat_Primary", Err)
End Sub
ChartAxis_Format_ValuesSecondary
Public Sub ChartAxis_Values_FormatSecondary(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal objBefore As clsChartSettings, _
ByVal objChartType As g_enChartTypeList, _
ByVal bIncludeXAxisTitle As Boolean)
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_ValuesFormat_Secondary")
If (Chart_IsPie(objChart) = True) Then
Exit Sub
End If
Call Axis_TitleFormat(objChart, enChartType, True, xlValue, xlSecondary)
If modChart.Available_AxisSecondary(objChart, xlValue) = True Then
If objBefore.Axis3MajorUnit <> 0 Then
objChart.Axes(xlValue, xlSecondary).MinimumScale = objBefore.Axis3Min
objChart.Axes(xlValue, xlSecondary).MaximumScale = objBefore.Axis3Max
objChart.Axes(xlValue, xlSecondary).MajorUnit = objBefore.Axis3MajorUnit
Else
objChart.Axes(xlValue, xlSecondary).Delete
End If
End If
If modChart.Available_AxisSecondary(objChart, xlCategory) = True Then
If objChart.Axes(xlCategory, xlSecondary).CategoryType <> xlCategoryScale Then
If Not objBefore.Axis4MajorUnit = 0 Then
objChart.Axes(xlCategory, xlSecondary).MinimumScale = objBefore.Axis4Min
objChart.Axes(xlCategory, xlSecondary).MaximumScale = objBefore.Axis4Max
objChart.Axes(xlCategory, xlSecondary).MajorUnit = objBefore.Axis4MajorUnit
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = objBefore.Axis4LabelFormat
End If
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Axis_ValuesFormat_Secondary", Err)
End Sub
ChartAxis_ScaleMaximum
Public Function ChartAxis_ScaleMaximum(ByVal objChart As Excel.Chart) As Long
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_ScaleMaximum")
If InStr(TypeName(Selection), "Chart") Then
If modChart.Available_AxisSecondary(objChart, xlCategory) = True Then
If Chart_IsScatter(objChart.Axes(xlCategory, xlSecondary)) And _
objChart.Axes(xlCategory, xlSecondary).TickLabelPosition = xlLow Then
Axis_ScaleMaximum = objChart.Axes(xlCategory, xlSecondary).MaximumScale
End If
ElseIf Chart_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
If Chart_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
Axis_ScaleMaximum = objChart.Axes(xlCategory, xlPrimary).MaximumScale
End If
End If
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Axis_ScaleMaximum", Err)
End Function
ChartAxis_ScaleMinimum
Public Function ChartAxis_ScaleMinimum(ByVal objChart As Excel.Chart) As Long
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Axis_ScaleMinimum")
If InStr(TypeName(Selection), "Chart") Then
If modChart.Available_AxisSecondary(objChart, xlSecondary) = True Then
If Chart_IsScatter(objChart.Axes(xlCategory, xlSecondary)) And _
objChart.Axes(xlCategory, xlSecondary).TickLabelPosition = xlLow Then
Axis_ScaleMinimum = objChart.Axes(xlCategory, xlSecondary).MinimumScale
End If
ElseIf Chart_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
If Chart_IsScatter(objChart.Axes(xlCategory, xlPrimary)) Then
Axis_ScaleMinimum = objChart.Axes(xlCategory, xlPrimary).MinimumScale
End If
End If
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Axis_ScaleMinimum", Err)
End Function
ChartFormat_ChartArea
Public Sub Format_ChartArea(ByVal objChart As Excel.Chart, _
ByVal dbChartWidth As Double, _
ByVal dbChartHeight As Double)
On Error GoTo AnError
objChart.HasTitle = False
objChart.ChartArea.Border.LineStyle = xlLineStyleNone
If (dbChartWidth > 0.5) Then
objChart.Parent.Width = dbChartWidth - 0.5
End If
If (dbChartHeight > 0) Then
objChart.Parent.Height = dbChartHeight
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_ChartArea", Err)
End Sub
ChartFormat_DataLabels
Public Sub ChartFormat_DataLabels(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal bIncludeDataLabels As Boolean)
Dim icount As Integer
On Error GoTo AnError
If (bIncludeDataLabels = True) Then
If (enChartType = Pie) Then
objChart.ApplyDataLabels Type:=xlDataLabelsShowLabelAndPercent
Else
objChart.ApplyDataLabels Type:=xlDataLabelsShowValue
For icount = 1 To objChart.SeriesCollection.Count
objChart.SeriesCollection(icount).DataLabels.NumberFormat = "#,###"
Next icount
End If
Else
objChart.ApplyDataLabels xlDataLabelsShowNone
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_DataLabels", Err)
End Sub
ChartFormat_Gridlines
Public Sub ChartFormat_Gridlines(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal bIncludeGridlines As Boolean)
On Error GoTo AnError
If (enChartType <> Pie) Then
If (bIncludeGridlines = True) Then
objChart.Axes(xlValue).HasMajorGridlines = True
objChart.Axes(xlValue).MajorGridlines.Border.ColorIndex = 15
objChart.Axes(xlValue).MajorGridlines.Border.Weight = 1
objChart.Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
Else
objChart.Axes(xlValue).HasMajorGridlines = False
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_Gridlines", Err)
End Sub
ChartFormat_Legend
Public Sub ChartFormat_Legend(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal bincludelegend As Boolean)
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Format_Legend")
If (bincludelegend = True) Then
objChart.HasLegend = True
If (enChartType = eArea) Then
objChart.Legend.Position = xlLegendPositionRight
objChart.PlotArea.Height = objChart.ChartArea.Height
objChart.PlotArea.Width = objChart.ChartArea.Width
objChart.PlotArea.Width = objChart.PlotArea.Width - objChart.Legend.Width
Else
objChart.Legend.Position = xlLegendPositionBottom
objChart.PlotArea.Width = objChart.ChartArea.Width
objChart.PlotArea.Height = objChart.ChartArea.Height
objChart.PlotArea.Height = objChart.PlotArea.Height - objChart.Legend.Height
End If
objChart.Legend.Border.LineStyle = xlNone
objChart.Legend.Shadow = False
objChart.Legend.Interior.ColorIndex = xlNone
Else
objChart.HasLegend = False
objChart.PlotArea.Width = objChart.ChartArea.Width
objChart.PlotArea.Height = objChart.ChartArea.Height
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_Legend", Err)
End Sub
ChartHas_Available_AxisMajorUnit
Public Function ChartHas_Available_AxisMajorUnit(ByVal objAxis As Excel.Axis) As Boolean
Dim dbValue As Double
On Error GoTo AnError
dbValue = objAxis.MajorUnit
Available_AxisMajorUnit = True
Exit Function
AnError:
Available_AxisMajorUnit = False
End Function
ChartHas_Available_AxisPrimaryCategoryType
Public Function ChartHas_Available_AxisPrimaryCategoryType(ByVal objChart As Excel.Chart) As Boolean
Dim objcategorytype As Excel.XlCategoryType
On Error GoTo AnError
objcategorytype = objChart.Axes(xlCategory, xlPrimary).CategoryType
Available_AxisPrimaryCategoryType = True
Exit Function
AnError:
Available_AxisPrimaryCategoryType = False
End Function
ChartHas_Available_AxisTickLabels
Public Function ChartHas_Available_AxisTickLabels(ByVal objAxis As Excel.Axis) As Boolean
Dim objTickLabels As Excel.TickLabels
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Available_TickLabels")
Set objTickLabels = objAxis.TickLabels
Available_AxisTickLabels = True
Exit Function
AnError:
Available_AxisTickLabels = False
End Function
ChartHas_AxisPrimary
Public Function ChartHas_AxisPrimary(ByVal objChart As Excel.Chart, _
ByVal enAxisType As Excel.XlAxisType) As Boolean
Dim breturn As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Has_AxisPrimary")
breturn = objChart.HasAxis(enAxisType, xlPrimary)
Has_AxisPrimary = breturn
Exit Function
AnError:
Has_AxisPrimary = False
End Function
ChartHas_AxisSecondary
Public Function ChartHas_AxisSecondary(ByVal objChart As Excel.Chart, _
ByVal enAxisType As Excel.XlAxisType) As Boolean
Const sPROCNAME As String = "ChartHas_AxisSecondary"
Dim breturn As Boolean
On Error GoTo ErrorHandler
Call Tracer_AddSubroutineStart(msMODULENAME, sPROCNAME)
breturn = objChart.HasAxis(enAxisType, xlSecondary)
ChartHas_AxisSecondary = breturn
ExitRoutine:
Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
breturn = False
If DEBUG_MODE Then
Stop
Resume
Else
Resume ExitRoutine
End If
End Function
ChartHas_AxisTitle
Public Function ChartHas_AxisTitle(ByVal objAxis As Excel.Axis) As Boolean
On Error GoTo AnError
ChartHas_AxisTitle = objAxis.HasTitle
Exit Function
AnError:
ChartHas_AxisTitle = False
End Function
ChartHas_ChartTitle
Public Function ChartHas_ChartTitle(ByVal objChart As Excel.Chart) As Boolean
On Error GoTo AnError
ChartHas_ChartTitle = objChart.HasTitle
Exit Function
AnError:
ChartHas_ChartTitle = False
End Function
ChartHas_DataLabels
Public Function ChartHas_DataLabels(ByVal objChart As Excel.Chart) As Boolean
Dim icount As Integer
Dim objDataLabels As Excel.DataLabels
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "ChartHas_DataLabels")
For icount = 1 To objChart.SeriesCollection.Count
Set objDataLabels = objChart.SeriesCollection(icount).DataLabels
If (objDataLabels.ShowValue = True Or _
objDataLabels.ShowBubbleSize = True Or _
objDataLabels.ShowLegendKey = True Or _
objDataLabels.ShowPercentage = True Or _
objDataLabels.ShowSeriesName = True Or _
objDataLabels.ShowCategoryName = True) Then
ChartHas_DataLabels = True
Exit Function
End If
Next icount
ChartHas_DataLabels = False
Exit Function
AnError:
ChartHas_DataLabels = False
End Function
ChartHas_Gridlines
Public Function ChartHas_Gridlines(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList) As Boolean
Dim breturn As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "ChartHas_Gridlines")
If (enChartType = ePie) Then
breturn = False
Else
breturn = objChart.Axes(xlValue).HasMajorGridlines Or objChart.Axes(xlValue).HasMinorGridlines
End If
ChartHas_Gridlines = breturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartHas_Gridlines", Err)
End Function
ChartHas_Legend
Public Function ChartHas_Legend(ByVal objChart As Excel.Chart) As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "Chart_HasLegend")
ChartHas_Legend = objChart.HasLegend
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartHas_Legend", Err)
End Function
ChartHas_SeriesCollection
Public Function ChartHas_SeriesCollection(ByVal objChart As Excel.Chart, _
ByVal iseriescount As Integer) As Boolean
Dim objSeries As Excel.Series
On Error GoTo AnError
Set objSeries = objChart.SeriesCollection(iseriescount)
Available_SeriesCollection = True
Exit Function
AnError:
Available_SeriesCollection = False
End Function
ChartReturns_ChartHeight
Public Function ChartReturns_ChartHeight(ByVal schartsize As String) As Double
Dim dbreturn As Double
On Error GoTo AnError
Select Case schartsize
Case "Single (Indented)": dbreturn = g_dbCHARTAREA_SINGLEINDENTED_HEIGHT
Case "Side by Side": dbreturn = g_dbCHARTAREA_SIDEBYSIDE_HEIGHT
Case "Single (Full Width)": dbreturn = g_dbCHARTAREA_SINGLEFULLWIDTH_HEIGHT
Case "Cover": dbreturn = g_dbCHARTAREA_COVER_HEIGHT
Case "Landscape Side by Side": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_HEIGHT
Case "Landscape Side by Side (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_HEIGHT
Case "Landscape Single (Full Width)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_HEIGHT
Case "Landscape Single (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_HEIGHT
Case "Landscape Three Across": dbreturn = g_dbCHARTAREA_LANDSCAPETHREEACROSS_HEIGHT
Case "Data Page": dbreturn = g_dbCHARTAREA_DATAPAGE_HEIGHT
Case Else
End Select
ChartReturns_ChartHeight = dbreturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Return_ChartHeight", Err)
End Function
ChartReturns_ChartSize
Public Function ChartReturns_SizeIdentify(ByVal objChart As Excel.Chart) As String
Dim dbwidth As Double
Dim dbheight As Double
On Error GoTo AnError
dbwidth = objChart.Parent.Width
dbheight = objChart.Parent.Height
If (Abs(dbwidth - g_dbCHARTAREA_SINGLEINDENTED_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_SINGLEINDENTED_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Single (Indented)": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_SIDEBYSIDE_WIDTH) < 2) And _
(Abs(dbheight = g_dbCHARTAREA_SIDEBYSIDE_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Side by Side": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_SINGLEFULLWIDTH_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_SINGLEFULLWIDTH_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Single (Full Width)": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_COVER_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_COVER_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Cover": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Landscape Side by Side": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Landscape Side by Side (Full Page)": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Landscape Single (Full Width)": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Landscape Single (Full Page)": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_LANDSCAPETHREEACROSS_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_LANDSCAPETHREEACROSS_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Landscape Three Across": Exit Function
End If
If (Abs(dbwidth - g_dbCHARTAREA_DATAPAGE_WIDTH) < 2) And _
(Abs(dbheight - g_dbCHARTAREA_DATAPAGE_HEIGHT) < 2) Then
ChartReturns_SizeIdentify = "Data Page": Exit Function
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_SizeIdentify", Err)
End Function
ChartReturns_ChartWidth
Public Function ChartReturns_ChartWidth(ByVal schartsize As String) As Double
Dim dbreturn As Double
On Error GoTo AnError
Select Case schartsize
Case "Single (Indented)": dbreturn = g_dbCHARTAREA_SINGLEINDENTED_WIDTH
Case "Side by Side": dbreturn = g_dbCHARTAREA_SIDEBYSIDE_WIDTH
Case "Single (Full Width)": dbreturn = g_dbCHARTAREA_SINGLEFULLWIDTH_WIDTH
Case "Cover": dbreturn = g_dbCHARTAREA_COVER_WIDTH
Case "Landscape Side by Side": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_WIDTH
Case "Landscape Side by Side (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_WIDTH
Case "Landscape Single (Full Width)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_WIDTH
Case "Landscape Single (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_WIDTH
Case "Landscape Three Across": dbreturn = g_dbCHARTAREA_LANDSCAPETHREEACROSS_WIDTH
Case "Data Page": dbreturn = g_dbCHARTAREA_DATAPAGE_WIDTH
Case Else
End Select
ChartReturns_ChartWidth = dbreturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Return_ChartWidth", Err)
End Function
ChartReturns_PlotAreaHeight
Public Function ChartReturns_PlotAreaHeight(ByVal schartsize As String) As Double
Dim dbreturn As Double
On Error GoTo AnError
Select Case schartsize
Case "Single (Indented)": dbreturn = g_dbPLOTAREA_SINGLEINDENTED_HEIGHT
Case "Side by Side": dbreturn = g_dbPLOTAREA_SIDEBYSIDE_HEIGHT
Case "Single (Full Width)": dbreturn = g_dbPLOTAREA_SINGLEFULLWIDTH_HEIGHT
Case "Cover": dbreturn = g_dbPLOTAREA_COVER_HEIGHT
Case "Landscape Side by Side": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_HEIGHT - 20
Case "Landscape Side by Side (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_HEIGHT - 20
Case "Landscape Single (Full Width)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_HEIGHT - 20
Case "Landscape Single (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_HEIGHT - 20
Case "Landscape Three Across": dbreturn = g_dbCHARTAREA_LANDSCAPETHREEACROSS_HEIGHT - 20
Case "Data Page": dbreturn = g_dbCHARTAREA_DATAPAGE_HEIGHT
Case Else
End Select
ChartReturns_PlotAreaHeight = dbreturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Return_PlotAreaHeight", Err)
End Function
ChartReturns_PlotAreaWidth
Public Function ChartReturns_PlotAreaWidth(ByVal schartsize As String) As Double
Dim dbreturn As Double
On Error GoTo AnError
Select Case schartsize
Case "Single (Indented)": dbreturn = g_dbPLOTAREA_SINGLEINDENTED_WIDTH
Case "Side by Side": dbreturn = g_dbPLOTAREA_SIDEBYSIDE_WIDTH
Case "Single (Full Width)": dbreturn = g_dbPLOTAREA_SINGLEFULLWIDTH_WIDTH
Case "Cover": dbreturn = g_dbPLOTAREA_COVER_WIDTH
Case "Landscape Side by Side": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDE_WIDTH - 10
Case "Landscape Side by Side (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESIDEBYSIDEFULLPAGE_WIDTH - 10
Case "Landscape Single (Full Width)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLWIDTH_WIDTH - 10
Case "Landscape Single (Full Page)": dbreturn = g_dbCHARTAREA_LANDSCAPESINGLEFULLPAGE_WIDTH - 10
Case "Landscape Three Across": dbreturn = g_dbCHARTAREA_LANDSCAPETHREEACROSS_WIDTH - 10
Case "Data Page": dbreturn = g_dbCHARTAREA_DATAPAGE_WIDTH
Case Else
End Select
ChartReturns_PlotAreaWidth = dbreturn
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Return_PlotAreaWidth", Err)
End Function
ChartSeries_AxisUsed
Public Function ChartSeries_WhichAxis(ByVal objChart As Excel.Chart) As String
Const sPROCNAME As String = "ChartSeries_WhichAxis"
Dim swhichaxis As String
Select Case objChart.SeriesCollection(iseriescount).AxisGroup
Case 1: swhichaxis = "Primary"
Case 2: swhichaxis = "Secondary"
Case Else
End Select
ChartSeries_WhichAxis = swhichaxis
Exit Sub
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function
ChartSeries_Format_TrendlineAdd
Public Sub ChartSeries_Format_TrendlineAdd(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal bIncludeTrendline As Boolean)
On Error GoTo AnError:
If (bIncludeTrendline = True) Then
If (enChartType <> Area) Then
With objChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:=False)
End With
End If
Else
If (objChart.SeriesCollection(1).Trendlines.Count > 0) Then
objChart.SeriesCollection(1).Trendlines(1).Delete
End If
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_Trendlines", Err)
End Sub
ChartSeries_FormatScatter
Public Sub ChartSeries_Format_AxesScatter(ByVal objChart As Excel.Chart, _
ByVal enChartType As g_enChartTypeList, _
ByVal objBefore As clsChartSettings, _
ByVal iNoOfIntervals As Integer, _
ByVal bOptionsRetainScaleFormat As Boolean, _
ByVal bOptionsScatterDates As Boolean)
Dim dbMajorUnit As Double
Dim sngRangeCount As Single
Dim sngStartDate As Single
Dim sngEndDate As Single
Dim lDivisor As Long
Dim clsChartSeries As New ChartSeries
On Error GoTo AnError
With clsChartSeries
.Chart = objChart
.ChartSeries = 1
' Establish start and end points for x axis (scatter)
sngRangeCount = .XValues.Count
sngEndDate = .XValues(sngRangeCount).Value
sngStartDate = .XValues(1).Value
End With
If (iNoOfIntervals > 0) Then
lDivisor = iNoOfIntervals
Else
lDivisor = objBefore.Axis2NumCats / objBefore.Axis2LabelSp
End If
If (sngEndDate > sngStartDate) Then
dbMajorUnit = (sngEndDate - sngStartDate) / lDivisor
Else
' This covers the possibility that the dates/values are in reverse order in the range
dbMajorUnit = (sngStartDate - sngEndDate) / lDivisor
End If
If (sngEndDate > sngStartDate) Then
objChart.Axes(xlCategory, xlPrimary).MinimumScale = sngStartDate
objChart.Axes(xlCategory, xlPrimary).MaximumScale = sngEndDate
Else
objChart.Axes(xlCategory, xlPrimary).MinimumScale = sngEndDate
objChart.Axes(xlCategory, xlPrimary).MaximumScale = sngStartDate
End If
objChart.Axes(xlCategory, xlPrimary).MajorUnit = dbMajorUnit
objChart.Axes(xlCategory, xlPrimary).CrossesAt = objChart.Axes(xlCategory, xlPrimary).MinimumScale
If (enChartType = Scatter_Line) Or _
(enChartType = Scatter_Line_w_Markers) Then
If (bOptionsScatterDates = True) Then
objChart.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = _
smartDateFormat(sngStartDate, sngEndDate)
End If
End If
If (bOptionsRetainScaleFormat = False) Then
objChart.Axes(xlCategory, xlSecondary).MinimumScale = sngStartDate
objChart.Axes(xlCategory, xlSecondary).MaximumScale = sngEndDate
objChart.Axes(xlCategory, xlSecondary).MajorUnit = dbMajorUnit
objChart.Axes(xlCategory, xlSecondary).TickLabelPosition = xlLow
If (enChartType = Scatter_Line) Or _
(enChartType = Combo_Column_ScatterLine) Or _
(enChartType = Combo_2Lines_ScatterColumn) Then
If (bOptionsScatterDates = True) Then
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = _
smartDateFormat(sngStartDate, sngEndDate)
Else
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = "dd-mmm-yy"
End If
Else
objChart.Axes(xlCategory, xlSecondary).TickLabels.NumberFormat = "#,###"
End If
objChart.Axes(xlCategory, xlPrimary).MajorTickMark = xlTickMarkNone
objChart.Axes(xlCategory, xlPrimary).TickLabelPosition = xlNone
objChart.Axes(xlValue, xlPrimary).TickLabelPosition = xlHigh
End If
Exit Sub
AnError:
Call Error_Handle(msMODULENAME, "Format_AxesScatter", Err)
End Sub
ChartSeries_FormulaBubbleSizesGet
Public Function ChartSeries_FormulaBubbleSizesGet(ByVal objSeries As Excel.Series, _
Optional ByVal bInformUser As Boolean = False) As String
Dim sFormula As String
Dim icharpos As Integer
On Error GoTo AnError
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartSeries_FormulaBubbleSizesGet", Err)
End Function
ChartSeries_FormulaNameGet
Public Function ChartSeries_FormulaNameGet(ByVal objSeries As Excel.Series, _
Optional ByVal bInformUser As Boolean = False) As String
Dim sFormula As String
Dim icharpos As Integer
On Error GoTo AnError
sFormula = objSeries.Formula
sFormula = Right(sFormula, Len(sFormula) - Len("=SERIES("))
icharpos = InStr(1, sFormula, ",")
ChartSeries_FormulaNameGet = Left(sFormula, icharpos)
If (bInformUser = True) Then
Call MsgBox("The 'Name' is:" & _
vbCrLf & vbCrLf & _
ChartSeries_FormulaNameGet & _
vbCrLf & vbCrLf & _
"from the formula:" & vbCrLf & _
objSeries.Formula)
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartSeries_FormulaNameGet", Err)
End Function
ChartSeries_FormulaPlotOrderGet
Public Function ChartSeries_FormulaPlotOrderGet(ByVal objSeries As Excel.Series, _
Optional ByVal bInformUser As Boolean = False) As String
'Dim sFormula As String
'Dim icharpos As Integer
On Error GoTo AnError
ChartSeries_FormulaPlotOrderGet = objSeries.PlotOrder
' sFormula = objSeries.Formula
' sFormula = Right(sFormula, Len(sFormula) - Len("=SERIES("))
'
' If Left(sFormula, 1) <> "'" Then
' icharpos = InStr(sFormula, ",")
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' Else
' icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
'
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
' End If
'
' If Left(sFormula, 1) <> "'" Then
' icharpos = InStr(sFormula, ",")
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' Else
' icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
' End If
'
' If Left(sFormula, 1) <> "'" Then
' icharpos = InStr(sFormula, ",")
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' Else
' icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
' sFormula = Right(sFormula, Len(sFormula) - icharpos)
' sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
' End If
'
' If (InStr(1, sFormula, ",") = -1) Then
' ChartSeries_FormulaPlotOrderGet = Left(sFormula, InStr(1, sFormula, ",") - 1)
' Else
' 'bubble sizes are provided
' ChartSeries_FormulaPlotOrderGet = Left(sFormula, Len(sFormula) - 1)
' End If
If (bInformUser = True) Then
Call MsgBox("The 'Plot Order' is:" & _
vbCrLf & vbCrLf & _
ChartSeries_FormulaPlotOrderGet & _
vbCrLf & vbCrLf & _
"from the formula:" & vbCrLf & _
objSeries.Formula)
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartSeries_FormulaPlotOrderGet", Err)
End Function
ChartSeries_FormulaXValuesGet
Public Function ChartSeries_FormulaXValuesGet(ByVal objSeries As Excel.Series, _
Optional ByVal bInformUser As Boolean = False) As String
Dim sFormula As String
Dim icharpos As Integer
On Error GoTo AnError
sFormula = objSeries.Formula
sFormula = Right(sFormula, Len(sFormula) - Len("=SERIES("))
If Left(sFormula, 1) <> "'" Then
icharpos = InStr(sFormula, ",")
sFormula = Right(sFormula, Len(sFormula) - icharpos)
Else
icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
sFormula = Right(sFormula, Len(sFormula) - icharpos)
sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
End If
If Left(sFormula, 1) <> "'" Then
icharpos = InStr(sFormula, ",")
Else
icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
End If
ChartSeries_FormulaXValuesGet = Left(sFormula, InStr(icharpos, sFormula, ",") - 1)
If (bInformUser = True) Then
Call MsgBox("The 'X-Values' are:" & _
vbCrLf & vbCrLf & _
ChartSeries_FormulaXValuesGet & _
vbCrLf & vbCrLf & _
"from the formula:" & vbCrLf & _
objSeries.Formula)
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartSeries_FormulaXValuesGet", Err)
End Function
ChartSeries_FormulaYValuesGet
Public Function ChartSeries_FormulaYValuesGet(ByVal objSeries As Excel.Series, _
Optional ByVal bInformUser As Boolean = False) As String
Dim sFormula As String
Dim icharpos As Integer
On Error GoTo AnError
sFormula = objSeries.Formula
sFormula = Right(sFormula, Len(sFormula) - Len("=SERIES("))
If Left(sFormula, 1) <> "'" Then
icharpos = InStr(sFormula, ",")
sFormula = Right(sFormula, Len(sFormula) - icharpos)
Else
icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
sFormula = Right(sFormula, Len(sFormula) - icharpos)
sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
End If
If Left(sFormula, 1) <> "'" Then
icharpos = InStr(sFormula, ",")
sFormula = Right(sFormula, Len(sFormula) - icharpos)
Else
icharpos = modChartSeries.Str_FindPositionOfOddSeq(sFormula, "!", "'", 3)
sFormula = Right(sFormula, Len(sFormula) - icharpos)
sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
End If
ChartSeries_FormulaYValuesGet = Left(sFormula, InStr(1, sFormula, ",") - 1)
If (bInformUser = True) Then
Call MsgBox("The 'Y-Values' are:" & _
vbCrLf & vbCrLf & _
ChartSeries_FormulaYValuesGet & _
vbCrLf & vbCrLf & _
"from the formula:" & vbCrLf & _
objSeries.Formula)
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartSeries_FormulaYValuesGet", Err)
End Function
ChartSeries_Type_IsItScatter
Public Function ChartSeries_Type_IsItScatter(ByVal objSeries As Excel.Series) As Boolean
On Error GoTo AnError
Call Tracer_AddSubroutineStart(msMODULENAME, "ChartType_SeriesTypeIsItScatter")
ChartType_SeriesTypeIsItScatter = False
Select Case objSeries.ChartType
Case xlXYScatter, _
xlXYScatterLines, _
xlXYScatterLinesNoMarkers, _
xlXYScatterSmooth, _
xlXYScatterSmoothNoMarkers
ChartType_SeriesTypeIsItScatter = True
Case Else
ChartType_SeriesTypeIsItScatter = False
End Select
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "ChartType_SeriesTypeIsItScatter", Err)
End Function
'****************************************************************************************
ChartSource_DataAddAdditionalRange
Public Function ChartSource_DataAddAdditionalRange(ByVal objChart As Excel.Chart, _
ByRef rgeAllRanges As Excel.Range, _
ByRef sPlottedBy As String, _
ByRef sMoreDetails As String)
Dim rgeAreas1 As Excel.Range
Dim rgeAreas2 As Excel.Range
Dim rgeAreas3 As Excel.Range
Dim rgeAdditionCell As Excel.Range
On Error GoTo AnError
If (rgeAllRanges.Areas.Count = 1) Then
If objChart.PlotBy = XlRowCol.xlRows Then sPlottedBy = "Rows"
If objChart.PlotBy = XlRowCol.xlColumns Then sPlottedBy = "Columns"
Exit Function
End If
If (rgeAllRanges.Areas.Count = 2) Then
If objChart.PlotBy = XlRowCol.xlRows Then sPlottedBy = "Rows"
If objChart.PlotBy = XlRowCol.xlColumns Then sPlottedBy = "Columns"
Exit Function
End If
If (rgeAllRanges.Areas.Count = 3) Then
Set rgeAreas1 = rgeAllRanges.Areas(1) '1 is always green
Set rgeAreas2 = rgeAllRanges.Areas(2) '2 is always purple
Set rgeAreas3 = rgeAllRanges.Areas(3) '3 is always blue
If (Ranges_SameColumns(rgeAreas1, rgeAreas2) And _
Ranges_SameRows(rgeAreas2, rgeAreas3) Or Ranges_SameRows(rgeAreas1, rgeAreas3)) Then
sPlottedBy = "Rows"
'Debug.Print "Plotted by Rows, Intersection rows : " & rgeAreas2.Address & " with columns : " & rgeAreas1.Address
If (rgeAreas2.Rows.Count = 1) And (rgeAreas1.Columns.Count = 1) Then
Set rgeAdditionCell = Application.Intersect(ActiveSheet.Rows(rgeAreas2.Row).Cells, _
ActiveSheet.Columns(rgeAreas1.Column).Cells)
Set rgeAllRanges = Application.Union(rgeAllRanges, rgeAdditionCell)
If (sMoreDetails = "none") Then sMoreDetails = "Additional cell has been added to the range"
End If
End If
If (Ranges_SameColumns(rgeAreas1, rgeAreas3) And _
Ranges_SameRows(rgeAreas1, rgeAreas2) Or Ranges_SameRows(rgeAreas2, rgeAreas3)) Then
sPlottedBy = "Columns"
'Debug.Print "Plotted by Columns, Intersection rows : " & rgeAreas1.Address & " with columns : " & rgeAreas2.Address
If (rgeAreas1.Rows.Count = 1) And (rgeAreas2.Columns.Count = 1) Then
Set rgeAdditionCell = Application.Intersect(ActiveSheet.Rows(rgeAreas1.Row).Cells, _
ActiveSheet.Columns(rgeAreas2.Column).Cells)
Set rgeAllRanges = Application.Union(rgeAllRanges, rgeAdditionCell)
If (sMoreDetails = "none") Then sMoreDetails = "Additional cell has been added to the range"
End If
End If
End If
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_SourceDataIsValid", Err)
End Function
ChartSource_DataGet
Public Function ChartSource_DataGet(ByVal objChart As Excel.Chart, _
ByRef sMoreDetails As String, _
ByRef sPlottedBy As String) As String
Dim iseriesno As Integer
Dim swbkname As String
Dim swshname As String
Dim srange As String
Dim rgecompleterange As Excel.Range
Dim sseries_name As String
Dim sseries_xvalues As String
Dim sseries_yvalues As String
Dim sseries_plotorder As String
Dim vsSeriesNameRefs() As String
Dim rgeSeriesNames As Range
On Error GoTo AnError
sMoreDetails = "none"
sPlottedBy = ""
ReDim vsSeriesNameRefs(ActiveChart.SeriesCollection.Count - 1)
For iseriesno = 1 To ActiveChart.SeriesCollection.Count
sseries_name = ChartSeries_FormulaNameGet(ActiveChart.SeriesCollection(iseriesno), False)
If (Len(sseries_name) > 0) Then
swshname = CellRef_ReturnComponent(sseries_name, "Worksheet")
srange = CellRef_ReturnComponent(sseries_name, "Range")
vsSeriesNameRefs(iseriesno - 1) = srange
If (rgecompleterange Is Nothing) Then
Set rgecompleterange = Sheets(swshname).Range(srange)
Set rgeSeriesNames = Sheets(swshname).Range(srange)
Else
Set rgecompleterange = Application.Union(rgecompleterange, Sheets(swshname).Range(srange))
Set rgeSeriesNames = Application.Union(rgeSeriesNames, Sheets(swshname).Range(srange))
End If
End If
sseries_xvalues = ChartSeries_FormulaXValuesGet(ActiveChart.SeriesCollection(iseriesno), False)
If (Len(sseries_xvalues) > 0) Then
swshname = CellRef_ReturnComponent(sseries_xvalues, "Worksheet")
srange = CellRef_ReturnComponent(sseries_xvalues, "Range")
If (rgecompleterange Is Nothing) Then
Set rgecompleterange = Sheets(swshname).Range(srange)
Else
Set rgecompleterange = Application.Union(rgecompleterange, Sheets(swshname).Range(srange))
End If
End If
sseries_yvalues = ChartSeries_FormulaYValuesGet(ActiveChart.SeriesCollection(iseriesno), False)
If (Len(sseries_yvalues) > 0) Then
swshname = CellRef_ReturnComponent(sseries_yvalues, "Worksheet")
srange = CellRef_ReturnComponent(sseries_yvalues, "Range")
If (rgecompleterange Is Nothing) Then
Set rgecompleterange = Sheets(swshname).Range(srange)
Else
Set rgecompleterange = Application.Union(rgecompleterange, Sheets(swshname).Range(srange))
End If
End If
Next iseriesno
'------------ check if an additional range needs to be added ??
Call Chart_SourceData_AddAdditionalRange(ActiveChart, rgecompleterange, sPlottedBy, sMoreDetails)
If (sMoreDetails <> "none") Then sPlottedBy = "Complex"
Debug.Print "Plotted by : " & sPlottedBy
'------------ check if the series has been re-ordered ??
For iseriesno = 1 To ActiveChart.SeriesCollection.Count
If (rgeSeriesNames.Cells(iseriesno).Address <> vsSeriesNameRefs(iseriesno - 1)) Then
sMoreDetails = "Plot Order has been re-ordered"
sPlottedBy = "Complex"
End If
Next iseriesno
Chart_SourceDataGet = rgecompleterange.Address
Exit Function
AnError:
Call Error_Handle(msMODULENAME, "Chart_SourceDataGet", Err)
End Function
ChartSource_DataSummary
Public Sub ChartSource_DataSummary(ByVal objChart As Excel.Chart)
Dim sMoreDetails As String
Dim sPlottedBy As String
Debug.Print Chart_SourceDataGet(objChart, sMoreDetails, sPlottedBy)
Debug.Print sPlottedBy & " - " & sMoreDetails
Debug.Print ""
End Sub
Message_AllChartsHaveBeenRecoloured
Public Sub Message_AllChartsHaveBeenRecoloured( _
ByVal lNoOfCharts As Long, _
ByVal sOnThis As String)
Dim sMessage As String
If (lNoOfCharts = 1) Then
sMessage = "The one chart on this " & sOnThis & " has been updated."
End If
If (lNoOfCharts > 1) Then
sMessage = "The '" & lNoOfCharts & "' charts on this " & sOnThis & " have been updated."
End If
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Charts Updated")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_BubbleInvalidNoOfSeries
Public Sub Message_BubbleInvalidNoOfSeries()
Dim sMessage As String
sMessage = "You need '3' series to create a valid 'Bubble' chart." & _
vbCrLf & vbCrLf & _
"A bubble chart requires an x-value, y-value and z-value (size) series."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Incorrect Data")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_CannotReorderSeriesDifferentChart
Public Sub Message_CannotReorderSeriesDifferentChart()
Dim sMessage As String
sMessage = "The active chart has changed, press 'Refresh Dialog' to update the series."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Different Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_ChartSizeIncorrect
Public Sub Message_ChartSizeIncorrect()
Dim sMessage As String
sMessage = "You must select a valid chart size."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Chart Size")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_CheckSourceData
Public Sub Message_CheckSourceData()
Dim sMessage As String
sMessage = "Please check your source data. Scatter charts must have numeric/date values on the x axis."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Source Data")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_CustomChartCannotBeFormatted
Public Sub Message_CustomChartCannotBeFormatted()
Dim sMessage As String
sMessage = "You cannot format a chart with a Chart Type of 'Custom'." & _
vbCrLf & vbCrLf & _
"Please select a different chart type."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Custom Chart Type")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_MustSelectAScatterChart
Public Sub Message_MustSelectAScatterChart()
Dim sMessage As String
sMessage = "You must select a chart with a scatter x-axis."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Scatter Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NeedToSelectChartArea
Public Sub Message_NeedToSelectChartArea()
Dim sMessage As String
sMessage = "You need to select the entire chart area."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Chart Area")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NewSeriesLoaded
Public Sub Message_NewSeriesLoaded()
Dim sMessage As String
sMessage = "New series is loaded."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Series Loaded")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoCellSelectedForDataLabel
Public Sub Message_NoCellSelectedForDataLabel()
Dim sMessage As String
sMessage = "You have not provided the valid 'Label Range'." & _
vbCrLf & vbCrLf & _
"Select the cells containing the text you want displayed."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Select Cells")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoChartIsSelected
Public Sub Message_NoChartIsSelected()
Dim sMessage As String
sMessage = "No chart is selected." & _
vbCrLf & vbCrLf & _
"Please select a chart and try again."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Invalid Selection")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoChartOrRangeIsSelected
Public Sub Message_NoChartOrRangeIsSelected()
Dim sMessage As String
sMessage = "Invalid selection, please select a chart or a range."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "No Chart or Range")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoChartsFound
Public Sub Message_NoChartsFound( _
sType As String)
Dim sMessage As String
sMessage = "There are no charts to update " & sType & "."
Call MsgBox(sMessage, vbOKOnly + vbInformation, ""No Charts Found")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoChartsOnActiveWorksheet
Public Sub Message_NoChartsOnActiveWorksheet()
Dim sMessage As String
sMessage = "There are no charts on this worksheet."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "No Charts Found")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_NoChartsOnChartSheets
Public Sub Message_NoChartsOnChartSheets()
Dim sMessage As String
sMessage = "Chart Sheets are not supported." & _
vbCrLf & vbCrLf & _
"Please move this chart to an object on a worksheet."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Move Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_ScatterChartAxisNotDateTime
Public Sub Message_ScatterChartAxisNotDateTime()
Dim sMessage As String
sMessage = "This chart should be formatted as a 'Line' chart not a 'Scatter Line' chart." & _
vbCrLf & vbCrLf & _
"The 'Scatter Intervals' feature will be disabled." & _
vbCrLf & _
"The horizontal axis is not a time series (its numerical)."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Scatter Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_ScatterChartAxisNotNumerical
Public Sub Message_ScatterChartAxisNotNumerical()
Dim sMessage As String
sMessage = "This chart should be formatted as a 'Line' chart not a 'Scatter Line' chart." & _
vbCrLf & vbCrLf & _
"The 'Scatter Intervals' feature will be disabled." & _
vbCrLf & _
"The horizontal axis is not a time series (its text)."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Scatter Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_ScatterChartNotTimeScaleAxis_Combo
Public Sub Message_ScatterChartNotTimeScaleAxis_Combo()
Dim sMessage As String
sMessage = "This 'Combination' chart should have date values." & _
vbCrLf & vbCrLf & _
"The 'Scatter Intervals' feature cannot be used on this combination chart."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Combo Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_SelectionNotAChartObject
Public Sub Message_SelectionNotAChartObject( _
ByVal sObjectName As String)
Dim sMessage As String
sMessage = "The object that is currently selected is not a chart." & _
vbCrLf & vbCrLf & _
"This object has been identified as a '" & sObjectName & "'."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "No Chart Selected")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_StockChartUnableToCreate
Public Sub Message_StockChartUnableToCreate()
Dim sMessage As String
sMessage = "To create this stock chart, arrange the data on your sheet in this order:" & _
vbCrLf & _
"high price, low price, closing price" & _
vbCrLf & vbCrLf & _
"Use dates or stock names as labels."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Stock Chart")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_StockInvalidNoOfSeries
Public Sub Message_StockInvalidNoOfSeries()
Dim sMessage As String
sMessage = "You need '3' or '4' series to create a valid 'Stock' chart." & _
vbCrLf & vbCrLf & _
"A stock chart requires a high, low and close series."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Incorrect Data")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_TreemapInvalidNoOfSeries
Public Sub Message_TreemapInvalidNoOfSeries()
Dim sMessage As String
sMessage = "You need '1' series to create a valid 'Treemap' chart." & _
vbCrLf & vbCrLf & _
"A treemap chart requires a single series."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Incorrect Data")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_UpdateAxisNotApplied
Public Sub Message_UpdateAxisNotApplied()
Dim sMessage As String
sMessage = "The chart option 'Retain Axis Scale and Intervals' is currently switched on'." & _
vbCrLf & vbCrLf & _
"If you want to change the start date, end date or intervals you need to turn this checkbox off."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "X-Axis Cannot be Updated")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Message_ValidStartEndDates
Public Sub Message_ValidStartEndDates()
Dim sMessage As String
sMessage = "Please assure you've specified valid start and end dates."
Call MsgBox(sMessage, vbOKOnly + vbInformation, "Start End Dates")
Call Tracer_Add("MESSAGE", sMessage)
End Sub
Question_ChartTooWide
Public Function Question_ChartTooWide() As VbMsgBoxResult
Dim sMessage As String
Dim response As VbMsgBoxResult
sMessage = "The chart is wider than 8.5 inches and may be truncated." & _
vbCrLf & vbCrLf & _
"Do you want to continue?"
response = MsgBox(sMessage, vbYesNo + vbQuestion, "Too Wide")
Call Tracer_Add("QUESTION", sMessage)
Question_ChartTooWide = response
End Function
Question_CreateNewChartUsingThisSourceData
Public Function Question_CreateNewChartUsingThisSourceData() As VbMsgBoxResult
Dim sMessage As String
Dim response As VbMsgBoxResult
sMessage = "Do you want to create a new chart with the same source data ?" & _
vbCrLf & vbCrLf & _
"Press No to apply the formatting to this chart." & _
vbCrLf & _
"Press Yes to create a new chart."
response = MsgBox(sMessage, vbYesNo + vbQuestion + vbDefaultButton2, "Same Source Data")
Call Tracer_Add("QUESTION", sMessage)
Question_CreateNewChartUsingThisSourceData = response
End Function
Question_WantToReloadSeriesCollection
Public Function Question_WantToReloadSeriesCollection() As VbMsgBoxResult
Dim sMessage As String
Dim response As VbMsgBoxResult
sMessage = "You have selected a new chart. Do you want to reload series collection of new selected chart?"
response = MsgBox(sMessage, vbYesNo + vbQuestion, "Reload Series")
Call Tracer_Add("QUESTION", sMessage)
Question_WantToReloadSeriesCollection = response
End Function
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top