C# Snippets
Chart_Add
Add a chart providing the source data, chart type and location.Public Function Chart_Add(ByVal lTypeOfChart As Long, _
ByVal sColFirst As String, _
ByVal iRowFirst As Integer, _
ByVal sColLast As String, _
ByVal iRowLast As Integer, _
Optional ByVal bPlotByColumn As Boolean = True, _
Optional ByVal sChartLocation As String = "Embedded Chart", _
Optional ByVal sPlaceCol As String = "", _
Optional ByVal iPlaceRow As Integer = 0, _
Optional ByVal sSourceWshName As String = "", _
Optional ByVal sChartWshName As String = "") _
As Excel.Chart
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim objChart As Excel.Chart
Dim objChartLocation As Excel.XlChartLocation
Try
If clsError.ErrorFlag() = True Then Exit Function
If sChartWshName <> "" Then
objWorksheet = CType(gApplication.Sheets(sChartWshName), Excel.Worksheet)
objWorksheet.Select()
End If
If sChartWshName = "" Then
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
sChartWshName = objWorksheet.Name
End If
If sSourceWshName = "" Then sSourceWshName = sChartWshName
If gbUPDATE_SCREEN = False Then gApplication.ScreenUpdating = False
gApplication.Charts.Add()
objChart = CType(gApplication.ActiveChart, Excel.Chart)
objChart.ChartType = CType(lTypeOfChart, Excel.XlChartType)
'because Pie and Bubble charts create a chart title by default
objChart.HasTitle = False
'defaults to columns !!!
objWorksheet = CType(gApplication.Sheets(sSourceWshName), Excel.Worksheet)
objRange = objWorksheet.Range(sColFirst & iRowFirst & ":" & sColLast & iRowLast)
objChart.SetSourceData(Source:=objRange)
If bPlotByColumn = True Then objChart.PlotBy = Excel.XlRowCol.xlColumns
If bPlotByColumn = False Then objChart.PlotBy = Excel.XlRowCol.xlRows
If sChartLocation = "Embedded Chart" Then
objChartLocation = Excel.XlChartLocation.xlLocationAsObject
objChart.Location(Where:=objChartLocation, Name:=sChartWshName)
End If
If sChartLocation = "Chart Sheet" Then
objChartLocation = Excel.XlChartLocation.xlLocationAsNewSheet
objChart.Location(Where:=objChartLocation)
'change the view % on the chart sheet to 100% - maybe have option to change default
gApplication.ActiveWindow.Zoom = 100
End If
If gbUPDATE_SCREEN = False Then gApplication.ScreenUpdating = True
If ((sPlaceCol <> "") And (iPlaceRow <> 0)) Then
Call Chart_Move(sPlaceCol, iPlaceRow, Chart_NameReturn)
End If
Chart_Add = objChart
'include where to place the chart
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbUPDATE_SCREEN = False Then gApplication.ScreenUpdating = True
Dim serrortext As String
objWorksheet = Nothing
objRange = Nothing
objChart = Nothing
If ((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
gApplication.ScreenUpdating = True
gApplication.DisplayAlerts = False
If TypeName(gApplication.ActiveSheet) = "Chart" Then
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
objWorksheet.Delete()
End If
gApplication.DisplayAlerts = True
If sSourceWshName <> "" Then serrortext = sSourceWshName & "!"
serrortext = _
serrortext & sColFirst & iRowFirst & ":" & sColLast & iRowLast & """ "
If sChartWshName = "" Then serrortext = serrortext & "on the active worksheet"
If sChartWshName <> "" Then _
serrortext = serrortext & "to the worksheet """ & sChartWshName & """"
End If
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_Add", msMODULENAME, _
"add a chart of type '" & lTypeOfChart & "'" & vbCrLf & _
"with the source data '" & serrortext & "'" & vbCrLf & _
"and place it at cell '" & sPlaceCol & iPlaceRow & "'." & _
" This may not be a valid chart type.", _
gobjCOMException, gobjException)
End If
End Try
End Function
Chart_Format
Public Sub Chart_Format(ByVal objChart As Excel.Chart, _
Optional ByVal sChartlocation As String = "Embedded Chart")
Dim objChartArea As Excel.ChartArea
Dim objSeriesCol As Excel.SeriesCollection
Dim objSeries As Excel.Series
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim schartsize As String
Dim iseriescount As Integer
Dim sngfontsize As Single
If gbUPDATE_SCREEN = False Then gApplication.ScreenUpdating = False
'need to check the number of series and display a message if too many !!
'define the palette colours for the series
Call Colour_SeriesIndexDefine()
objChartArea = objChart.ChartArea
objSeriesCol = CType(objChart.SeriesCollection, Excel.SeriesCollection)
If sChartlocation = "Embedded Chart" Then
schartsize = App_ChartSizeReturn(objChart)
sngfontsize = App_ChartFontSize(schartsize)
Else
'otherwise must be "Chart Sheet"
sngfontsize = 14
'purely for testing !!!
gbUPDATE_SCREEN = False
End If
Call Chart_AreaFormat(objChart, _
gsDEF_FONTNAME, _
sngfontsize, _
giDEF_FONTCOLOUR_PALETTE, _
gsDEF_FONTBACKGROUND, _
gbDEF_FONTBOLD, _
, , , , , , , , , giDEF_PALETTEWHITE)
Call Chart_PlotAreaFormat(objChart, _
, , , giDEF_PALETTEWHITE)
Call Chart_LegendFormat(objChart, _
gsDEF_FONTNAME, _
sngfontsize, _
giDEF_FONTCOLOUR_PALETTE, _
gsDEF_FONTBACKGROUND, _
, , , , , , , , , , giDEF_PALETTEWHITE)
Call Chart_PlotAreaSizeMove(objChart, _
objChartArea.Width, 1, _
objChartArea.Height, 1)
Call Chart_TitleSizePosition(objChart, , sngfontsize)
Call Chart_LegendSizePosition(objChart, , sngfontsize)
If Chart_AxesExists(objChart, "P", "C") = True Then
Call Chart_AxesTitleSizePosition(objChart, "P", "C")
Call Chart_AxesFormat(objChart, "P", "C")
Call Chart_AxesXOptions(objChart, "P", "C")
End If
If Chart_AxesExists(objChart, "P", "V") = True Then
Call Chart_AxesTitleSizePosition(objChart, "P", "V")
Call Chart_AxesFormat(objChart, "P", "V")
Call Chart_AxesXOptions(objChart, "P", "V")
Call Chart_AxesYScaleAdjustToRP(objChart, "P", "V", False, True)
End If
If Chart_AxesExists(objChart, "S", "C") = True Then
Call Chart_AxesTitleSizePosition(objChart, "S", "C")
Call Chart_AxesFormat(objChart, "S", "C")
Call Chart_AxesXOptions(objChart, "S", "C")
End If
If Chart_AxesExists(objChart, "S", "V") = True Then
Call Chart_AxesTitleSizePosition(objChart, "S", "V")
Call Chart_AxesFormat(objChart, "S", "V")
Call Chart_AxesXOptions(objChart, "S", "V")
Call Chart_AxesYScaleAdjustToRP(objChart, "S", "V", False, True)
End If
For iseriescount = 1 To objSeriesCol.Count
If clszLateBindingExcel.ChartSeriesValid(objSeriesCol, _
iseriescount) = True Then
objSeries = objSeriesCol.Item(iseriescount)
Call ChartType_SeriesFormatLineOrArea(objChart, objSeries, iseriescount)
Call ChartType_SeriesFormat(objChart, "", objSeries, iseriescount)
End If
Next iseriescount
'purely for testing !!! to stop flickering with Chart Sheets
gbUPDATE_SCREEN = True
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbUPDATE_SCREEN = False Then gApplication.ScreenUpdating = True
objChart = Nothing
objChartArea = Nothing
objSeriesCol = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_Format", msMODULENAME, _
"format the chart completely.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
'***************************************************************************************
Chart_HeightReturn
Public Function Chart_HeightReturn() As String
Dim objWorksheet As Excel.Worksheet
Dim objChart As Excel.Chart
Dim objChartObject As Excel.ChartObject
Try
If clsError.ErrorFlag() = True Then Exit Function
If Chart_InOne() = False Then
Chart_HeightReturn = "Nothing"
Exit Function
End If
objChart = gApplication.ActiveChart
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
objChartObject = CType(objChart.Parent, Excel.ChartObject)
Chart_HeightReturn = CType(objChartObject.Height, String)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_HeightReturn", msMODULENAME, _
"return the height of the active chart", _
gobjCOMException, gobjException)
End If
End Try
End Function
Chart_InOne
Returns a boolean indicating if the current selection is inside a chart.Public Function Chart_InOne(Optional ByVal bInformUser As Boolean = False) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
If Chart_ObjectValid(TypeName(gApplication.Selection)) = True Then
Chart_InOne = True
Else
Chart_InOne = False
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
'If bInformUser = True Then
'INCLUDE a message !!
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_InOne", msMODULENAME, _
"determine if you are in a chart.", _
gobjCOMException, gobjException)
End If
End Try
End Function
'****************************************************************************************
Chart_LocationGet
Public Shared Function LocationGet(ByVal objChart As Excel.Chart) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case TypeName(objChart.Parent)
Case "Workbook", "WorkbookClass"
LocationGet = "Chart Sheet"
Case "ChartObject"
LocationGet = "Embedded Chart"
Case Else
Call MsgBox("TypeName(objChart.Parent) = " & TypeName(objChart.Parent))
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG_EXCEL = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("LocationGet", "clsChart", _
"return the location of the active chart, whether chart sheet or embedded.", _
mobjCOMException, mobjException)
End If
End Try
End Function
Chart_Move
Public Sub Chart_Move(ByVal sPlaceCol As String, _
ByVal iPlaceRow As Integer, _
Optional ByVal sChartName As String = "", _
Optional ByVal sWshName As String = "")
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngfromleft As Single
Dim sngfromright As Single
' ActiveWorkbook.Styles("Normal").Font.Name = "Arial"
' ActiveWorkbook.Styles("Normal").Font.Size = 10
sngfromleft = clsCol.WidthToPoints("A", sPlaceCol)
sngfromright = clsRow.HeightToPoints(1, iPlaceRow)
Call Chart_MoveTopLeft(sngfromleft, sngfromright, _
sPlaceCol & iPlaceRow, sChartName)
' ActiveWorkbook.Styles("Normal").Font.Name = "Arial"
' ActiveWorkbook.Styles("Normal").Font.Size = 10
' Selection.Style = "Normal"
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_Move", msMODULENAME, _
"move the chart a small distance ??", _
gobjCOMException, gobjException)
End If
End Try
End Sub
Chart_MoveTopLeft
Public Sub Chart_MoveTopLeft(ByVal sngFromLeft As Single, _
ByVal sngFromTop As Single, _
Optional ByVal sReturnCell As String = "", _
Optional ByVal sChartName As String = "", _
Optional ByVal sWshName As String = "")
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim objChartObject As Excel.ChartObject
Try
If clsError.ErrorFlag() = True Then Exit Sub
If sWshName <> "" Then
objWorksheet = CType(gApplication.Sheets(sWshName), Excel.Worksheet)
objWorksheet.Select()
End If
If sChartName = "" Then sChartName = Chart_NameReturn()
objRange = objWorksheet.Range("A1")
objRange.Select()
objChartObject = CType(objWorksheet.ChartObjects(sChartName), Excel.ChartObject)
objChartObject.Left = sngFromLeft
objChartObject.Top = sngFromTop
If sReturnCell <> "" Then
objRange = objWorksheet.Range(sReturnCell)
objRange.Select() 'deactivates the chart
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objRange = Nothing
objChartObject = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_MoveTopLeft", msMODULENAME, _
"move the chart '" & sChartName & "'" & vbCrLf & _
sngFromLeft & " from the left" & vbCrLf & _
sngFromTop & " from the top" & vbCrLf & _
"relative to the worksheet.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
Chart_NameGet
Public Function Chart_NameGet(Optional ByVal sChartName As String = "") _
As String
Dim objWorksheet As Excel.Worksheet
Dim objChart As Excel.Chart
Try
If clsError.ErrorFlag() = True Then Exit Function
If Chart_InOne() = False Then
Chart_NameGet = "Nothing"
Exit Function
End If
If sChartName.Length = 0 Then
objChart = gApplication.ActiveChart
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
sChartName = objChart.Name
Chart_NameGet = sChartName.Substring(Len(objWorksheet.Name) + 1)
Else
Chart_NameGet = sChartName
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_NameReturn", msMODULENAME, _
"return the name of the active chart.", _
gobjCOMException, gobjException)
End If
End Try
End Function
Chart_NameReturn
Public Function Chart_NameReturn(Optional ByVal bSelectCell As Boolean = False) _
As String
Dim objWorksheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim objChart As Excel.Chart
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sChartName As String
If Chart_InOne() = False Then
Chart_NameReturn = "Nothing"
Exit Function
End If
objChart = gApplication.ActiveChart
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
sChartName = objChart.Name
Chart_NameReturn = sChartName.Substring(Len(objWorksheet.Name) + 1)
If bSelectCell = True Then
objRange = objWorksheet.Range("A1")
objRange.Select()
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objRange = Nothing
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_NameReturn", msMODULENAME, _
"return the name of the active chart", _
gobjCOMException, gobjException)
End If
End Try
End Function
Chart_ObjectValid
Public Function Chart_ObjectValid(ByVal sObjectName As String) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sObjectName & Space(12 - sObjectName.Length)
'copy from VBA
Case Else
'Call MsgBox(sObjectName & " - Chart_ObjectValid")
Chart_ObjectValid = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_ObjectValid", msMODULENAME, _
"determine if the object '" & sObjectName & "' is a valid chart object.", _
gobjCOMException, gobjException)
End If
End Try
End Function
'****************************************************************************************
Chart_Size
Public Sub Chart_Size(ByVal dbWidth As Double, _
ByVal dbHeight As Double, _
Optional ByVal sDeSelectCell As String = "", _
Optional ByVal sChartName As String = "", _
Optional ByVal sWshName As String = "")
Dim objWorksheet As Excel.Worksheet
Dim objChartObject As Excel.ChartObject
Dim objRange As Excel.Range
Try
If clsError.ErrorFlag() = True Then Exit Sub
If Len(sWshName) > 0 Then
objWorksheet = CType(gApplication.Worksheets(sWshName), Excel.Worksheet)
objWorksheet.Select()
Else
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
End If
If Len(sChartName) = 0 Then
sChartName = Chart_NameReturn()
End If
objChartObject = CType(objWorksheet.ChartObjects(sChartName), Excel.ChartObject)
objChartObject.Height = dbHeight
objChartObject.Width = dbWidth
objChartObject.Activate()
If sDeSelectCell <> "" Then
objRange = CType(objWorksheet.Range(sDeSelectCell), Excel.Range)
objRange.Select()
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objChartObject = Nothing
objRange = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_Size", msMODULENAME, _
"size the chart " & Chart_NameGet(sChartName), _
gobjCOMException, gobjException)
End If
End Try
End Sub
'****************************************************************************************
Chart_SizeObj
Public Sub Chart_SizeObj(ByVal objChart As Excel.Chart, _
ByVal dbWidth As Double, _
ByVal dbHeight As Double)
Dim objChartObject As Excel.ChartObject
Try
If clsError.ErrorFlag() = True Then Exit Sub
objChartObject = CType(objChart.Parent, Excel.ChartObject)
objChartObject.Height = dbHeight
objChartObject.Width = dbWidth
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChartObject = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_SizeObj", msMODULENAME, _
"change the chart object to the following size:" & vbCrLf & _
"Width: '" & dbWidth & "'" & vbCrLf & _
"Height: '" & dbHeight & "'", _
gobjCOMException, gobjException)
End If
End Try
End Sub
Chart_WidthReturn
Public Function Chart_WidthReturn() As String
Dim objWorksheet As Excel.Worksheet
Dim objChart As Excel.Chart
Dim objChartObject As Excel.ChartObject
Try
If clsError.ErrorFlag() = True Then Exit Function
If Chart_InOne() = False Then
Chart_WidthReturn = "Nothing"
Exit Function
End If
objChart = gApplication.ActiveChart
objWorksheet = CType(gApplication.ActiveSheet, Excel.Worksheet)
objChartObject = CType(objChart.Parent, Excel.ChartObject)
Chart_WidthReturn = CType(objChartObject.Width, String)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objWorksheet = Nothing
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_WidthReturn", msMODULENAME, _
"return the width of the active chart", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_Category_IsValueAxis
Public Function ChartAxis_CategoryIsValueAxis(ByVal objAxis As Excel.Axis) As Boolean
Dim enscaletype As XlScaleType
On Error GoTo AnError
enscaletype = objAxis.ScaleType
Axis_CategoryIsValueAxis = True
AnError:
Axis_CategoryIsValueAxis = False
End Function
ChartAxis_Exists
Public Function ChartAxis_Exists(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
Optional ByVal bInformUser As Boolean = False) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
If ChartType_SeriesTypeIsItPie(CType(objChart.SeriesCollection(1), _
Excel.Series)) = True Or _
ChartType_SeriesTypeIsItDoughnut(CType(objChart.SeriesCollection(1), _
Excel.Series)) = True Or _
ChartType_SeriesTypeIsItSurface(CType(objChart.SeriesCollection(1), _
Excel.Series)) = True Or _
ChartType_SeriesTypeIsIt3D(CType(objChart.SeriesCollection(1), _
Excel.Series)) Then
ChartAxis_Exists = False
Else
ChartAxis_Exists = CBool(objChart.HasAxis(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)))
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If bInformUser = True Then
Call App_MessageChartTypeDoesNotExist(sAxisGroup, sAxisType)
End If
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_Exists", msMODULENAME, _
"determine if the chart axes: " & _
"Axis Group - " & sAxisGroup & " Axis Type - " & sAxisType & " exists.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_Format
Public Sub ChartAxis_Format(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
Optional ByVal iAxisColourIdx As Integer = giDEF_PALETTEAXESCOLOUR)
Dim objAxis As Excel.Axis
Try
If clsError.ErrorFlag() = True Then Exit Sub
objAxis = CType(objChart.Axes(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)), Excel.Axis)
With objAxis
'.Border.Color =
.Border.ColorIndex = iAxisColourIdx
.Border.Weight = Excel.XlBorderWeight.xlHairline
.Border.LineStyle = Excel.XlLineStyle.xlContinuous
If .HasMajorGridlines = True Then
.MajorGridlines.Border.ColorIndex = iAxisColourIdx
.MajorTickMark = Excel.XlTickMark.xlTickMarkOutside
End If
If .HasMinorGridlines = True Then
.MinorGridlines.Border.ColorIndex = iAxisColourIdx
.MinorTickMark = Excel.XlTickMark.xlTickMarkNone
End If
.TickLabelPosition = Excel.XlTickLabelPosition.xlTickLabelPositionNextToAxis
.TickLabels.Orientation = _
Excel.XlTickLabelOrientation.xlTickLabelOrientationHorizontal
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objAxis = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_Format", msMODULENAME, _
"format the chart axis " & _
"AxisGroup - " & sAxisGroup & " AxisType - " & sAxisType & " axis.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
'****************************************************************************************
ChartAxis_ScaleAdjustmentLargest
Public Function ChartAxis_ScaleAdjustmentLargest(ByVal sngSmallest As Single, _
ByVal sngLargest As Single, _
Optional ByVal sngAccuracy As Single = 0.01) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sngdifference As Single
'calculate the actual difference
sngdifference = Math.Abs(sngLargest - sngSmallest)
If (sngSmallest <> 0) And (sngdifference < sngSmallest) Then
If sngLargest < 0 Then sngLargest = sngLargest - (sngdifference * sngAccuracy)
If sngLargest > 0 Then sngLargest = sngLargest + (sngdifference * sngAccuracy)
End If
If (sngSmallest <> 0) And (sngSmallest < sngdifference) Then
' I DONT THINK WE NEED BOTH OF THESE !!
If sngLargest < 0 Then sngLargest = sngLargest + (sngLargest * sngAccuracy)
If sngLargest > 0 Then sngLargest = sngLargest + (sngLargest * sngAccuracy)
End If
ChartAxis_LargestAdjustment = sngLargest
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_LargestAdjustment", msMODULENAME, _
"return the adjusted number for the largest value on an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_ScaleAdjustmentSmallest
Public Function ChartAxis_ScaleAdjustmentSmallest(ByVal sngSmallest As Single, _
ByVal sngLargest As Single, _
Optional ByVal sngAccuracy As Single = 0.01) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sngdifference As Single
'calculate the actual difference
sngdifference = Math.Abs(sngLargest - sngSmallest)
If (sngSmallest <> 0) And (sngdifference < sngSmallest) Then
If sngSmallest < 0 Then
sngSmallest = sngSmallest + (sngdifference * sngAccuracy)
End If
If sngSmallest > 0 Then
sngSmallest = sngSmallest - (sngdifference * sngAccuracy)
End If
End If
If (sngSmallest <> 0) And (sngSmallest < sngdifference) Then
If sngSmallest < 0 Then
sngSmallest = sngSmallest + (sngSmallest * sngAccuracy)
End If
If sngSmallest > 0 Then
sngSmallest = sngSmallest - (sngSmallest * sngAccuracy)
End If
End If
ChartAxis_SmallestAdjustment = sngSmallest
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_SmallestAdjustment", msMODULENAME, _
"return the adjusted number for the smallest value on an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_TitleSizePosition
Public Sub ChartAxis_TitleSizePosition(ByVal objChart As Excel.Chart, _
Optional ByVal sAxisGroup As String = "P", _
Optional ByVal sAxisType As String = "V", _
Optional ByVal bBold As Boolean = False)
Dim objWindow As Excel.Window
Dim objWorksheet As Excel.Worksheet
Dim objChartObject As Excel.ChartObject
Dim objAxis As Excel.Axis
Dim objRange As Excel.Range
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim ibeforewindowpercent As Integer
Dim scurrentname As String
'scurrentname = Chart_NameReturn(True)
''gApplication.ScreenUpdating = False
'objWindow = CType(gApplication.ActiveWindow, Excel.Window)
'ibeforewindowpercent = CInt(objWindow.Zoom)
'objWindow.Zoom = 50 'reduce screen to position title - CHECK WE NEED !!
'objWsh = CType(gApplication.ActiveSheet, Excel.Worksheet)
'objChartObject = CType(objWsh.ChartObjects(scurrentname), Excel.ChartObject)
'objChartObject.Activate()
'objChart = objChartObject.Chart
'objChart = CType(gApplication.ActiveChart, Excel.Chart)
objAxis = CType(objChart.Axes(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)), Excel.Axis)
With objChart
If objAxis.HasTitle = True Then
If bBold = True Then objAxis.AxisTitle.Font.Bold = bBold
'---------------------
If sAxisGroup = "P" And sAxisType = "C" Then
.PlotArea.Top = 1
.PlotArea.Height = .ChartArea.Height
.PlotArea.Height = .PlotArea.Height - giDEF_AXISTITLESPACE
'Selection.AxisTitle.Left = needs to be centered !!!!
objAxis.AxisTitle.Top = .ChartArea.Height - giDEF_AXISTITLESPACE
objAxis.AxisTitle.Orientation = 0 'title is horizontal
End If
'---------------------
If sAxisGroup = "P" And sAxisType = "V" Then
.PlotArea.Width = .ChartArea.Width
.PlotArea.Width = .PlotArea.Width - giDEF_AXISTITLESPACE - 4
.PlotArea.Left = 1
.PlotArea.Left = .PlotArea.Left + giDEF_AXISTITLESPACE
objAxis.AxisTitle.Top = .PlotArea.Height
objAxis.AxisTitle.Top = Int(objAxis.AxisTitle.Top / 2) - giDEF_XAXESSPACE
objAxis.AxisTitle.Left = 1
objAxis.AxisTitle.Orientation = 90 'title is 90 degrees
End If
'---------------------
If sAxisGroup = "S" And sAxisType = "C" Then
.PlotArea.Height = .ChartArea.Height - (2 * giDEF_AXISTITLESPACE)
.PlotArea.Top = .PlotArea.Top + giDEF_AXISTITLESPACE
'Selection.AxisTitle.Left = needs to be centered !!!!
objAxis.AxisTitle.Top = 1
objAxis.AxisTitle.Orientation = 0 'title is horizontal
End If
'---------------------
If sAxisGroup = "S" And sAxisType = "V" Then
.PlotArea.Width = .ChartArea.Width
.PlotArea.Width = .PlotArea.Width - giDEF_AXISTITLESPACE
'plotarea.left == as the width is reduced should move left automatically
objAxis.AxisTitle.Top = .PlotArea.Height
objAxis.AxisTitle.Top = Int(objAxis.AxisTitle.Top / 2) - giDEF_XAXESSPACE
objAxis.AxisTitle.Left = .ChartArea.Width - giDEF_AXISTITLESPACE + 2
objAxis.AxisTitle.Orientation = -90 'title is vertical reading right
End If
'---------------------
End If
End With
'objRange = CType(objWsh.Range("A1"), Excel.Range)
'objRange.Select()
'objWindow.Zoom = ibeforewindowpercent 'return the zoom percentage
'objChartObject.Activate()
'gApplication.ScreenUpdating = True
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objWindow = Nothing
objWorksheet = Nothing
objChartObject = Nothing
objAxis = Nothing
objRange = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_TitleSizePosition", msMODULENAME, _
"size and position the axis title for the chart axis " & _
"AxisGroup - " & sAxisGroup & " AxisType - " & sAxisType & " axis.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_XCalculateNoOfLabels
Public Function ChartAxis_XCalculateNoOfLabels(ByVal dbDaysDifference As Double) _
As Double
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim icount As Integer
Dim ismallestlabelno As Integer
Dim ismallestremainder As Integer
ismallestlabelno = 5
ismallestremainder = CInt(dbDaysDifference Mod ismallestlabelno)
For icount = 5 To 3 Step -1
If dbDaysDifference Mod icount = 0 Then
ismallestremainder = CInt(dbDaysDifference Mod icount)
ismallestlabelno = icount
Exit For
Else
If dbDaysDifference Mod icount < ismallestremainder Then
ismallestremainder = CInt(dbDaysDifference Mod icount)
ismallestlabelno = icount
End If
End If
Next icount
ChartAxis_XCalculateNoOfLabels = Math.Ceiling(dbDaysDifference / ismallestlabelno)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_XCalculateNoOfLabels", msMODULENAME, _
"return the number of labels required for the X-axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_XOptions
Public Sub ChartAxis_XOptions(ByVal objChart As Excel.Chart, _
Optional ByVal sAxisGroup As String = "P", _
Optional ByVal sAxisType As String = "V", _
Optional ByVal sAxisCategory As String = "AS", _
Optional ByVal bAxisShowIt As Boolean = True, _
Optional ByVal sAxisBaseUnit As String = "D", _
Optional ByVal sAxisMajorUnit As String = "M", _
Optional ByVal sAxisMinorUnit As String = "M", _
Optional ByVal sMajorTickMarkPos As String = "OU", _
Optional ByVal sMinorTickMarkPos As String = "OU", _
Optional ByVal sTickLabelPos As String = "NA", _
Optional ByVal bMinorGridlines As Boolean = False, _
Optional ByVal bMajorGridlines As Boolean = False, _
Optional ByVal sTickLabelFormat As String = "", _
Optional ByVal sTickLabelsOrientation As String = "AU", _
Optional ByVal iTickLabelSpacing As Integer = 1, _
Optional ByVal iTickMarkSpacing As Integer = 1, _
Optional ByVal bAxisBetweenCategories As Boolean = True, _
Optional ByVal iAxisCrossesAt As Integer = 0)
Dim objSelection As Object
Dim objAxis As Excel.Axis
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim dbnoofdaysdifference As Double
Dim iminimumdate As Integer
Dim imaximumdate As Integer 'declares for dates
objAxis = CType(objChart.Axes(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)), Excel.Axis)
'this automatically selects the whole chart area
objSelection = gApplication.Selection
objChart.HasAxis(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)) = True
'Throw New System.Exception("testing")
With objAxis
If sAxisType = "C" Then
If (.CategoryType = Excel.XlCategoryType.xlAutomaticScale) Then
.CategoryType = zReturn_AxisCategoryType(sAxisCategory)
End If
If (.CategoryType = Excel.XlCategoryType.xlTimeScale) Or _
(sAxisCategory = "TS") Then
.BaseUnit = zReturn_TimeSeriesUnit(sAxisBaseUnit)
End If
End If
.MinorTickMark = zReturn_TickMarkPosition(sMinorTickMarkPos)
.MajorTickMark = zReturn_TickMarkPosition(sMajorTickMarkPos)
'check that if the chart has gridlines they are deleted ????
.TickLabelPosition = zReturn_TickLabelPosition(sTickLabelPos)
'gridlines only for primary axes except 3D charts ??
'either primary axes either primary or secondary
If sAxisGroup = "P" Then
.HasMajorGridlines = bMajorGridlines
.HasMinorGridlines = bMinorGridlines
' If sAxisType = "C" Then .CrossesAt = lAxisCrossesAt few chart types ?
End If
'.ReversePlotOrder = False 'cannot be used on radar charts
If sAxisType = "C" Then
'------------------------- automatic
If (.CategoryType = Excel.XlCategoryType.xlAutomaticScale) Then
If sTickLabelFormat <> "" Then
.TickLabels.NumberFormat = sTickLabelFormat
Else
.TickLabels.NumberFormat = "0"
End If
.TickLabels.Orientation = _
zReturn_TickLabelOrientation(sTickLabelsOrientation)
End If
'------------------------- category
If (.CategoryType = Excel.XlCategoryType.xlCategoryScale) Then
If sTickLabelFormat <> "" Then
.TickLabels.NumberFormat = sTickLabelFormat
Else
.TickLabels.NumberFormat = "General"
End If
.AxisBetweenCategories = bAxisBetweenCategories
.TickLabelSpacing = iTickLabelSpacing
.TickMarkSpacing = iTickMarkSpacing
.TickLabels.Orientation = _
zReturn_TickLabelOrientation(sTickLabelsOrientation)
End If
'------------------------- time scale
If (.CategoryType = Excel.XlCategoryType.xlTimeScale) Then
If sTickLabelFormat <> "" Then
.TickLabels.NumberFormat = sTickLabelFormat
Else
.TickLabels.NumberFormat = "d-mmm-yy"
End If
.BaseUnit = zReturn_TimeSeriesUnit(sAxisBaseUnit)
dbnoofdaysdifference = .MaximumScale - .MinimumScale
.MajorUnit = ChartAxis_XCalculateNoOfLabels(dbnoofdaysdifference)
.MinorUnit = .MajorUnit 'default to show no minor tickmarks
.MajorUnitScale = Excel.XlTimeUnit.xlDays
.MinorUnitScale = .MajorUnitScale
' .Crosses = lAxisCrossesAt 'not radar charts !
.AxisBetweenCategories = bAxisBetweenCategories
.ReversePlotOrder = False
.TickLabels.Orientation = _
zReturn_TickLabelOrientation(sTickLabelsOrientation)
End If
'-------------------------
End If
End With
objChart.HasAxis(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)) = bAxisShowIt
Call clszLateBindingExcel.ChartSelectionActivate(objSelection)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objAxis = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_XOptions", msMODULENAME, _
"define the axis options for the chart axis " & _
"AxisGroup - " & sAxisGroup & " AxisType - " & sAxisType & " axis.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YCalculateXLines
Public Sub ChartAxis_YCalculateXLines(ByVal iarrayno As Integer, _
ByVal sngdifference As Single)
Try
If clsError.ErrorFlag() = True Then Exit Sub
'the correct power of 10 to multiple the ideal scale by
Dim sngMultipleFactor As Single
Dim iIdealPowerof10 As Integer
'giIdealPowerof10(iarrayno) = clsNumber.ReturnPowerOfTen(sngdifference / iarrayno)
iIdealPowerof10 = clsNumber.ReturnPowerOfTen(sngdifference / iarrayno)
'gsngMultipleFactor = clsNumber.TenToThePowerOf(giIdealPowerof10(iarrayno))
gsngMultipleFactor = clsNumber.TenToThePowerOf(iIdealPowerof10)
giAppScaleMultiple(iarrayno) = _
CInt(ChartAxis_YScaleChoose((sngdifference / iarrayno) * gsngMultipleFactor))
gsngActualScale(iarrayno) = giAppScaleMultiple(iarrayno) / gsngMultipleFactor
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YCalculateXLines", msMODULENAME, _
"calculate the corresponding number of X lines for the " & _
"Array No: " & iarrayno & " and Difference: " & sngdifference & ".", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YDecimalPlaces
Public Sub ChartAxis_YDecimalPlaces(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
ByVal iDecimalPlaces As Integer)
Dim objAxis As Excel.Axis
Dim objSeriesCol As Excel.SeriesCollection
Dim objSeries As Excel.Series
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim splaces As String
Dim icount As Integer
Dim bstacked100 As Boolean
splaces = "0."
For icount = 0 To iDecimalPlaces - 1
splaces = splaces & "0"
Next icount
objAxis = CType(objChart.Axes(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)), Excel.Axis)
'-----------------------
objSeriesCol = CType(objChart.SeriesCollection, Excel.SeriesCollection)
For icount = 1 To objSeriesCol.Count 'for all the chart series
objSeries = objSeriesCol.Item(icount)
If Chart_SeriesAxisUsed(objSeries) = sAxisGroup Then
'is series on the axis
If ChartType_SeriesTypeIsItStacked100(objSeries) = True Then
bstacked100 = True
End If
End If
Next icount
'-----------------------
If bstacked100 = True Then
'then the axis is for a stacked 100
'decimal places set before in format stacked
Else
'therefore chart is not 100% so set the decimal places
'temporarily set to General if RP scaling is not in effect
'objAxis.TickLabels.NumberFormat = "General"
If (iDecimalPlaces = 0) Then
objAxis.TickLabels.NumberFormat = "0"
Else
objAxis.TickLabels.NumberFormat = splaces
End If
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objAxis = Nothing
objSeriesCol = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YDecimalPlaces", msMODULENAME, _
"adjust the number of decimal places on the " & _
"(" & sAxisGroup & ") Y axis.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleAdjustStart
Public Function ChartAxis_YScaleAdjustStart(ByVal sngSmallest As Single, _
ByVal sngBestScaleUnits As Single) As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim icount As Integer
Dim sngrunning As Single
icount = 0 : sngrunning = 0 'shouldn't need this ! - why would it be zero
If sngBestScaleUnits <> 0 Then
icount = CInt((Math.Abs(sngSmallest) - sngBestScaleUnits) / sngBestScaleUnits)
sngrunning = sngBestScaleUnits * icount
Do Until sngrunning > Math.Abs(sngSmallest)
icount = icount + 1
sngrunning = sngBestScaleUnits * icount
Loop
End If
If sngSmallest > 0 Then
ChartAxes_YScaleAdjustStart = (icount - 1) * sngBestScaleUnits
End If
If sngSmallest < 0 Then
ChartAxes_YScaleAdjustStart = sngrunning
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAdjustStart", msMODULENAME, _
"return the starting scale for an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_YScaleAdjustToMicrosoft
Public Sub ChartAxis_YScaleAdjustToMicrosoft(ByVal objChart As Excel.Chart, _
Optional ByVal sAxisGroup As String = "P", _
Optional ByVal sAxisType As String = "V")
Try
If clsError.ErrorFlag() = True Then Exit Sub
If ChartAxis_Exists(objChart, sAxisGroup, sAxisType) = True Then
Call ChartAxis_YScaleMicrosoft(objChart, sAxisGroup)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAdjustToMicrosoft", msMODULENAME, _
"adjusts the scales of the axes to the 'Microsoft Automatic' scaling.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleAdjustToRP
Public Sub ChartAxis_YScaleAdjustToRP(ByVal objChart As Excel.Chart, _
Optional ByVal sAxisGroup As String = "P", _
Optional ByVal sAxisType As String = "V", _
Optional ByVal bToZeroScaling As Boolean = False, _
Optional ByVal bMicrosoftScale As Boolean = False)
Dim objSeriesCol As Excel.SeriesCollection
Dim objSeries As Excel.Series
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngSmallest As Single
Dim sngLargest As Single
Dim icount As Integer
Dim bnotstacked As Boolean
Dim bmultiplestacked As Boolean
Dim arrseriesvalues As System.Array
Dim sngseriesarray As Single()
Dim sngcurrenttotal As Single()
objSeriesCol = CType(objChart.SeriesCollection, Excel.SeriesCollection)
If ChartAxis_Exists(objChart, sAxisGroup, sAxisType) = True Then
bnotstacked = False
bmultiplestacked = False 'to determine if multiple series are stacked
For icount = 1 To objSeriesCol.Count 'for all the chart series
objSeries = objSeriesCol.Item(icount)
'is the series on a given axis
If Chart_SeriesAxisUsed(objSeries) = sAxisGroup Then
'------------------------------------------------
If ChartType_SeriesTypeIsItStacked100(objSeries) = False Then
arrseriesvalues = CType(objSeries.Values, System.Array)
sngseriesarray = clsArray.ArrayToSingleArray(arrseriesvalues)
If ChartType_SeriesTypeIsItStacked(objSeries) = True Then
'chart is STACKED
'------------------------------
If bmultiplestacked = False Then
'assign this first series to the temp array
sngcurrenttotal = sngseriesarray
sngSmallest = clsArray.ValueSmallestSingle("Smallest", sngcurrenttotal, sngSmallest)
sngLargest = clsArray.ValueLargestSingle("Largest", sngcurrenttotal, sngLargest)
'first series, so next one will be stacked
bmultiplestacked = True
'---------------
Else 'series is stacked on top of a previous series
sngcurrenttotal = clsArray.Arrays2AddSingle("Current Total", sngcurrenttotal, _
"Next Series", sngseriesarray)
'calculate smallest & largest from the sum series using this axis
sngSmallest = clsArray.ValueSmallestSingle("Smallest", sngcurrenttotal, sngSmallest)
sngLargest = clsArray.ValueLargestSingle("Largest", sngcurrenttotal, sngLargest)
End If
'------------------------------
Else 'chart is not STACKED
'------------------------------
If bnotstacked = False Then
sngSmallest = clsArray.ValueSmallestSingle("Smallest", sngseriesarray, sngSmallest)
sngLargest = clsArray.ValueLargestSingle("Largest", sngseriesarray, sngLargest)
bnotstacked = True
Else
sngSmallest = clsArray.ValueSmallestSingle("Smallest", sngseriesarray, sngSmallest)
sngLargest = clsArray.ValueLargestSingle("Largest", sngseriesarray, sngLargest)
End If
'------------------------------
End If
Else
If bMicrosoftScale = False Then
Call ChartAxis_YScaleDefine(objChart, sAxisGroup, sAxisType, 0, 100, 20)
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, 0)
Exit Sub
Else
Call ChartAxis_YScaleDefine(objChart, sAxisGroup, sAxisType, 0, 100)
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, 0)
End If
End If
'------------------------------------------------
End If
Next icount
If bMicrosoftScale = False Then
If bToZeroScaling = False Then
Call ChartAxis_YScaleAutomatic(objChart, sAxisGroup, sAxisType, _
sngSmallest, sngLargest)
Else
Call ChartAxis_YScaleAutomatic(objChart, sAxisGroup, sAxisType, _
0, sngLargest)
End If
Else
Call ChartAxis_YScaleMicrosoft(objChart, sAxisGroup)
'include an option either alwasy have 2 decimal places or automatic
'Call Chart_AxesYDecimalPlaces(objChart, sAxisGroup, sAxisType, 2)
Call ChartAxis_YScaleMicrosoftAlterDecimalPlaces(objChart, sAxisGroup, sAxisType)
End If
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objSeriesCol = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAdjustToRP", msMODULENAME, _
"determine the smallest and largest values for the scales on the axis " & _
" AxisGroup - " & sAxisGroup & " AxisType - " & sAxisType & ".", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleAdjustToRPBracket
Public Sub ChartAxis_YScaleAdjustToRPBracket(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
ByVal sngsmallestvalue As Single, _
ByVal snglargestvalue As Single, _
ByVal sngIdealStart As Single, _
ByVal sngIdealFinish As Single, _
ByVal sngIdealScale As Single)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngBestScaleUnits As Single
Dim iarrayno As Integer
Dim sngdifference As Single
Dim sngSmallest As Single
Dim sngLargest As Single
Dim sngstartscale As Single
Dim sngfinishscale As Single
sngSmallest = clsNumber.SmallestOneSingle(sngsmallestvalue, snglargestvalue)
sngLargest = clsNumber.LargestOneSingle(sngsmallestvalue, snglargestvalue)
sngdifference = Math.Abs(sngIdealFinish - sngIdealStart)
If clsNumber.IsItInRange(sngSmallest, sngIdealStart, sngIdealFinish) = True And _
clsNumber.IsItInRange(sngLargest, sngIdealStart, sngIdealFinish) = True Then
ReDim giAppScaleMultiple(giDEF_AXISSCALEMAX)
ReDim gsngActualScale(giDEF_AXISSCALEMAX)
For iarrayno = giDEF_AXISSCALEMIN To giDEF_AXISSCALEMAX
Call ChartAxis_YCalculateXLines(iarrayno, sngdifference)
Next iarrayno
sngstartscale = sngIdealStart
sngBestScaleUnits = sngIdealScale 'use the ideal scale given
giNoofLinesChosen = CInt(((sngIdealFinish - sngIdealStart) / sngIdealScale))
gsngMultipleFactor = clsNumber.TenToThePowerOf(giNoofLinesChosen)
sngfinishscale = sngIdealFinish
Call ChartAxis_YScaleDefine(objChart, sAxisGroup, sAxisType, _
sngstartscale, sngfinishscale, _
sngBestScaleUnits)
Call ChartAxis_YScaleAlterDecimalPlaces(objChart, sAxisGroup, sAxisType, _
sngBestScaleUnits)
Else
sngSmallest = ChartAxis_SmallestAdjustment(sngSmallest, sngLargest, _
gsngBRACKETCHARTACCURACY) 'fn above
sngLargest = ChartAxis_LargestAdjustment(sngSmallest, sngLargest, _
gsngBRACKETCHARTACCURACY) 'fn above
sngfinishscale = sngSmallest
If ((sngLargest - sngSmallest) < sngdifference) Then
Do Until (sngfinishscale > sngLargest) 'repeat until the scale is suitable
sngBestScaleUnits = sngIdealScale 'use the ideal scale given
sngstartscale = _
ChartAxis_YScaleGetStart(objChart, sngSmallest, sngBestScaleUnits)
giNoofLinesChosen = _
CInt(((sngIdealFinish - sngIdealStart) / sngIdealScale))
gsngMultipleFactor = clsNumber.TenToThePowerOf(giNoofLinesChosen)
sngfinishscale = _
ChartAxis_YScaleGetFinish(objChart, sngstartscale, sngBestScaleUnits)
'increments diff. if not successful
sngIdealFinish = CSng((sngIdealFinish * 1.01))
Loop
Call ChartAxis_YScaleDefine(objChart, sAxisGroup, sAxisType, _
sngstartscale, sngfinishscale, _
sngBestScaleUnits)
Call ChartAxis_YScaleAlterDecimalPlaces(objChart, sAxisGroup, sAxisType, _
sngBestScaleUnits)
Else
Call ChartAxis_YScaleAutomatic(objChart, sAxisGroup, sAxisType, _
sngSmallest, sngLargest)
End If
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAdjustToRPBracket", msMODULENAME, _
"adjust the scales of the axes to the 'RP Bracket Automatic' scaling.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleAlterDecimalPlaces
Public Sub ChartAxis_YScaleAlterDecimalPlaces(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
ByVal sngBestScaleUnits As Single)
Try
If clsError.ErrorFlag() = True Then Exit Sub
If (clsNumber.ReturnPowerOfTen(sngBestScaleUnits) >= 1) Then
If (gsngMultipleFactor = 15) Or (gsngMultipleFactor = 25) Then
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, _
clsNumber.ReturnPowerOfTen(sngBestScaleUnits))
Else
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, _
clsNumber.ReturnPowerOfTen(sngBestScaleUnits) - 1)
End If
Else 'scale is greater than 10, so no decimal places required
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, 0)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAlterDecimalPlaces", msMODULENAME, _
"adjust the number of decimal places on the " & _
"Axis Group - " & sAxisGroup & ".", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleAutomatic
Public Sub ChartAxis_YScaleAutomatic(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
ByVal sngsmallestvalue As Single, _
ByVal snglargestvalue As Single)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim iarrayno As Integer
Dim sngstartscale As Single
Dim sngfinishscale As Single
Dim sngSmallest As Single
Dim sngLargest As Single
Dim sngdifference As Single
Dim sngBestScaleUnits As Single
sngSmallest = clsNumber.SmallestOneSingle(sngsmallestvalue, snglargestvalue)
sngLargest = clsNumber.LargestOneSingle(sngsmallestvalue, snglargestvalue)
sngSmallest = ChartAxis_SmallestAdjustment(sngSmallest, sngLargest)
sngLargest = ChartAxis_LargestAdjustment(sngSmallest, sngLargest)
'calculate the actual difference
sngdifference = Math.Abs(sngLargest - sngSmallest)
sngfinishscale = sngSmallest
'repeat until the scale is suitable
Do Until (sngfinishscale > sngLargest)
ReDim giAppScaleMultiple(giDEF_AXISSCALEMAX)
ReDim gsngActualScale(giDEF_AXISSCALEMAX)
For iarrayno = giDEF_AXISSCALEMIN To giDEF_AXISSCALEMAX
Call ChartAxis_YCalculateXLines(iarrayno, sngdifference)
Next iarrayno
'calculates the best scale
sngBestScaleUnits = ChartAxis_YScaleChooseBest()
sngstartscale = ChartAxis_YScaleGetStart(objChart, sngSmallest, _
sngBestScaleUnits)
sngfinishscale = ChartAxis_YScaleGetFinish(objChart, sngstartscale, _
sngBestScaleUnits)
'increments diff. if not successful
sngdifference = CSng((sngdifference * 1.01))
Loop
Call ChartAxis_YScaleDefine(objChart, sAxisGroup, sAxisType, _
sngstartscale, sngfinishscale, _
sngBestScaleUnits)
Call ChartAxis_YScaleAlterDecimalPlaces(objChart, sAxisGroup, sAxisType, _
sngBestScaleUnits)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleAutomatic", msMODULENAME, _
"adjust the scales of the axes to the 'RP Automatic' scaling.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleChoose
Public Function ChartAxis_YScaleChoose(ByVal sngIdealScale As Single) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
If (10 < sngIdealScale) And (sngIdealScale <= 15) Then ChartAxis_YScaleChoose = 15
If (15 < sngIdealScale) And (sngIdealScale <= 20) Then ChartAxis_YScaleChoose = 20
If (20 < sngIdealScale) And (sngIdealScale <= 25) Then ChartAxis_YScaleChoose = 25
If (25 < sngIdealScale) And (sngIdealScale <= 50) Then ChartAxis_YScaleChoose = 50
If (50 < sngIdealScale) And (sngIdealScale <= 100) Then ChartAxis_YScaleChoose = 100
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleChoose", msMODULENAME, _
"choose the best scale for an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_YScaleChooseBest
Public Function ChartAxis_YScaleChooseBest(Optional ByVal sngIdealScale As Single = 0) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim iarrayno As Integer
Dim sngsmallestunit As Single
If sngIdealScale = 0 Then
'max no. of lines first
sngsmallestunit = gsngActualScale(giDEF_AXISSCALEMAX)
'start at maxno. of lines
For iarrayno = giDEF_AXISSCALEMAX To giDEF_AXISSCALEMIN Step -1
If (gsngActualScale(iarrayno) <= sngsmallestunit) Then
sngsmallestunit = gsngActualScale(iarrayno)
giNoofLinesChosen = iarrayno
gsngMultipleFactor = giAppScaleMultiple(iarrayno)
End If
Next iarrayno
Else
sngsmallestunit = sngIdealScale
End If
ChartAxis_YScaleChooseBest = sngsmallestunit
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleChooseBest", msMODULENAME, _
"choose the best scale for the Y-axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_YScaleDefine
Public Sub ChartAxis_YScaleDefine(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String, _
ByVal sngMinimum As Single, _
ByVal sngMaximum As Single, _
Optional ByVal sngMajorUnit As Single = 0, _
Optional ByVal sChartName As String = "", _
Optional ByVal sWshName As String = "")
Dim objAxis As Excel.Axis
Try
If clsError.ErrorFlag() = True Then Exit Sub
objAxis = CType(objChart.Axes(zReturn_AxisType(sAxisType), _
zReturn_AxisGroup(sAxisGroup)), Excel.Axis)
With objAxis
.MinimumScale = sngMinimum
.MaximumScale = sngMaximum
'maybe assign to the minor unit as well - to be sure ???
If sngMajorUnit > 0 Then .MajorUnit = sngMajorUnit 'assign the new max,min and unit
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objAxis = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleDefine", msMODULENAME, _
"define the scale for the AxisGroup - " & sAxisGroup & ".", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleGetFinish
Public Function ChartAxis_YScaleGetFinish(ByVal objChart As Excel.Chart, _
ByVal sngstartscale As Single, _
ByVal sngBestScaleUnits As Single) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
ChartAxis_YScaleGetFinish = sngstartscale + (sngBestScaleUnits * giNoofLinesChosen)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleGetFinish", msMODULENAME, _
"return the calculated largest value for the scale of an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_YScaleGetStart
Public Function ChartAxis_YScaleGetStart(ByVal objChart As Excel.Chart, _
ByVal sngSmallest As Single, _
ByVal sngBestScaleUnits As Single) _
As Single
Try
If clsError.ErrorFlag() = True Then Exit Function
If (sngSmallest = sngBestScaleUnits) Or (sngSmallest = 0) Then
ChartAxis_YScaleGetStart = sngSmallest
ElseIf sngSmallest > 0 Then
ChartAxis_YScaleGetStart = _
ChartAxes_YScaleAdjustStart(sngSmallest, sngBestScaleUnits)
ElseIf sngSmallest < 0 Then
ChartAxis_YScaleGetStart = _
-ChartAxes_YScaleAdjustStart(sngSmallest, sngBestScaleUnits)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleGetStart", msMODULENAME, _
"return the calculated smallest value for for the scale of an axis.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartAxis_YScaleMicrosoft
Public Sub ChartAxis_YScaleMicrosoft(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String)
Dim objAxis As Excel.Axis
Try
If clsError.ErrorFlag() = True Then Exit Sub
If sAxisGroup = "P" Then
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlPrimary), Excel.Axis)
End If
If sAxisGroup = "S" Then
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlSecondary), Excel.Axis)
End If
If (sAxisGroup <> "P") And (sAxisGroup <> "S") Then
Call MsgBox("Error - Chart_AxesYScaleMicrosoft")
Exit Sub
End If
With objAxis
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True 'set all the automatic settings to true
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objAxis = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleMicrosoft", msMODULENAME, _
"define the scale for the AxisGroup - " & sAxisGroup & _
"to be the ""Microsoft Automatic"" Scaling.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartAxis_YScaleMicrosoftAlterDecimalPlaces
Public Sub ChartAxis_YScaleMicrosoftAlterDecimalPlaces(ByVal objChart As Excel.Chart, _
ByVal sAxisGroup As String, _
ByVal sAxisType As String)
Dim objAxis As Excel.Axis
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngscaleunits As Single
If sAxisGroup = "P" Then
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlPrimary), Excel.Axis)
End If
If sAxisGroup = "S" Then
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlSecondary), Excel.Axis)
End If
With objAxis
sngscaleunits = CSng(.MajorUnit)
End With
If (clsNumber.ReturnPowerOfTen(sngscaleunits) >= 1) Then
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, _
clsNumber.ReturnPowerOfTen(sngscaleunits) - 1)
Else 'scale is greater than 10, so no decimal places required
Call ChartAxis_YDecimalPlaces(objChart, sAxisGroup, sAxisType, 0)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objAxis = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartAxis_YScaleMicrosoftAlterDecimalPlaces", msMODULENAME, _
"adjust the number of decimal places on the " & _
"Axis Group - " & sAxisGroup & ".", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_ChartArea
Public Sub ChartFormat_ChartArea(ByVal objChart As Excel.Chart, _
Optional ByVal sFontName As String = "AR", _
Optional ByVal sngFontSize As Single = 10, _
Optional ByVal iFontColourIdx As Integer = 1, _
Optional ByVal sFontBackground As String = "AU", _
Optional ByVal bBold As Boolean = False, _
Optional ByVal bItalic As Boolean = False, _
Optional ByVal sUnderline As String = "NO", _
Optional ByVal bStrikethrough As Boolean = False, _
Optional ByVal bSubscript As Boolean = False, _
Optional ByVal bSuperscript As Boolean = False, _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iInteriorColourIdx As Integer = 2, _
Optional ByVal sInteriorPatternStyle As String = "NO", _
Optional ByVal iFillForeColour As Integer = 1, _
Optional ByVal iFillBackColour As Integer = 1, _
Optional ByVal bFillAsSolid As Boolean = True, _
Optional ByVal sGradientColourType As String = "0", _
Optional ByVal sGradientStyle As String = "HR", _
Optional ByVal iGradientVariant As Integer = 0, _
Optional ByVal sngGradientDegree As Single = 0.5, _
Optional ByVal sGradientPresetType As String = "", _
Optional ByVal sTexturePresetType As String = "NO", _
Optional ByVal sFillPatternStyle As String = "NO")
Dim objChartArea As Excel.ChartArea
Dim objFont As Excel.Font
Try
If clsError.ErrorFlag() = True Then Exit Sub
objChartArea = objChart.ChartArea
With objChartArea
.AutoScaleFont = False 'prevents the Not Enough Memory error
objFont = .Font
With objFont
.Name = zReturn_FontName(sFontName)
.Size = sngFontSize
'.Color =
.ColorIndex = iFontColourIdx
.Background = zReturn_Background(sFontBackground)
.Bold = bBold
.Italic = bItalic
.Shadow = bShadow
.Underline = zReturn_UnderlineStyle(sUnderline)
.Strikethrough = bStrikethrough
.Subscript = bSubscript
.Superscript = bSuperscript
'.OutlineFont = False Not used on Windows
End With
.Border.Color = iBorderColour
.Border.Weight = zReturn_BorderWeight(iBorderWeight)
.Border.LineStyle = zReturn_LineStyle(sBorderLineStyle)
'chart area has a shadow property
.Shadow = bShadow
If (sInteriorPatternStyle = "NO") And _
(sGradientColourType = "0") And (sTexturePresetType = "NO") Then
.Fill.Solid()
.Interior.ColorIndex = iInteriorColourIdx
End If
If (sInteriorPatternStyle <> "NO") Then
.Interior.Pattern = zReturn_Pattern(sInteriorPatternStyle)
End If
If (sGradientColourType = "1") Then
'doesn't seem to work ?
'.Fill.ForeColor.RGB = RGB(120, 120, 120)
.Fill.ForeColor.SchemeColor = iFillForeColour
.Fill.OneColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
Degree:=sngGradientDegree)
End If
If (sGradientColourType = "2") Or _
((sInteriorPatternStyle <> "NO") And (sGradientColourType = "0")) Then
.Fill.ForeColor.SchemeColor = iFillForeColour
.Fill.BackColor.SchemeColor = iFillBackColour
.Fill.TwoColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant)
End If
If sGradientColourType = "P" Then
.Fill.PresetGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
PresetGradientType:= _
zReturn_PresetGradientType(sGradientPresetType))
End If
If sTexturePresetType <> "NO" Then
.Fill.PresetTextured(PresetTexture:= _
zReturn_PresetTextureType(sTexturePresetType))
End If
If sFillPatternStyle <> "NO" Then
.Fill.Patterned(Pattern:=zReturn_PatternType(sFillPatternStyle))
End If
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objChartArea = Nothing
objFont = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartFormat_ChartArea", msMODULENAME, _
"format the chart area on the active chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
'****************************************************************************************
ChartFormat_DataTableSizePosition
Public Sub ChartFormat_DataTableSizePosition(ByVal objChart As Excel.Chart, _
Optional ByVal sngFontSize As Single = 10)
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objChart
'-----------------
If .HasDataTable = True Then
'' .DataTable = bHasADataTable
End If
' .DataTable.Delete
End With
'ensure fonts are correct after re-sizing
objChart.ChartArea.Font.Size = sngFontSize
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_DataTableSizePosition", msMODULENAME, _
"adjust the size and position of the data table.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_Legend
Public Sub ChartFormat_Legend(ByVal objChart As Excel.Chart, _
Optional ByVal sFontName As String = "AR", _
Optional ByVal sngFontSize As Single = 10, _
Optional ByVal iFontColourIdx As Integer = 1, _
Optional ByVal sFontBackground As String = "AU", _
Optional ByVal bBold As Boolean = False, _
Optional ByVal bItalic As Boolean = False, _
Optional ByVal bUnderLine As Boolean = False, _
Optional ByVal bStrikethrough As Boolean = False, _
Optional ByVal bSubscript As Boolean = False, _
Optional ByVal bSuperscript As Boolean = False, _
Optional ByVal iBorderColour As Integer = 1, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iInteriorColourIdx As Integer = 2, _
Optional ByVal sInteriorPatternStyle As String = "NO", _
Optional ByVal iFillForeColour As Integer = 0, _
Optional ByVal iFillBackColour As Integer = 0, _
Optional ByVal bFillAsSolid As Boolean = True, _
Optional ByVal sGradientColourType As String = "0", _
Optional ByVal sGradientStyle As String = "HR", _
Optional ByVal iGradientVariant As Integer = 1, _
Optional ByVal sngGradientDegree As Single = 0.5, _
Optional ByVal sGradientPresetType As String = "", _
Optional ByVal sTexturePresetType As String = "NO", _
Optional ByVal sFillPatternStyle As String = "NO")
Try
If clsError.ErrorFlag() = True Then Exit Sub
If objChart.HasLegend = True Then
With objChart.Legend
With .Font
.Name = zReturn_FontName(sFontName)
.Size = sngFontSize
'.Color
.ColorIndex = iFontColourIdx
.Background = zReturn_Background(sFontBackground)
.Bold = bBold
.Italic = bItalic
.Shadow = bShadow
.Underline = bUnderLine
.Strikethrough = bStrikethrough
.Subscript = bSubscript
.Superscript = bSuperscript
End With
.Border.Color = iBorderColour
.Border.Weight = zReturn_BorderWeight(iBorderWeight)
.Border.LineStyle = zReturn_LineStyle(sBorderLineStyle)
.Shadow = bShadow
If (sTexturePresetType = "NO") And _
(sGradientColourType = "0") And (sInteriorPatternStyle = "NO") Then
.Fill.Solid()
.Interior.ColorIndex = iInteriorColourIdx
End If
If (sInteriorPatternStyle <> "NO") Then
.Interior.Pattern = zReturn_Pattern(sInteriorPatternStyle)
End If
If (sGradientColourType = "1") Then
.Fill.ForeColor.SchemeColor = iFillForeColour
End If
If (sGradientColourType = "2") Or _
((sInteriorPatternStyle <> "NO") And (sGradientColourType = "0")) Then
.Fill.ForeColor.SchemeColor = iFillForeColour
.Fill.BackColor.SchemeColor = iFillBackColour
End If
If sGradientColourType = "1" Then
.Fill.OneColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
Degree:=sngGradientDegree)
End If
If sGradientColourType = "2" Then
.Fill.TwoColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant)
End If
If sGradientColourType = "P" Then
.Fill.PresetGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
PresetGradientType:= _
zReturn_PresetGradientType(sGradientPresetType))
End If
If sTexturePresetType <> "NO" Then
.Fill.PresetTextured(PresetTexture:= _
zReturn_PresetTextureType(sTexturePresetType))
End If
If sFillPatternStyle <> "NO" Then
.Fill.Patterned(Pattern:=zReturn_PatternType(sFillPatternStyle))
End If
End With
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_LegendFormat", msMODULENAME, _
"format the legend on the active chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
'****************************************************************************************
ChartFormat_LegendSizePosition
Public Sub ChartFormat_LegendSizePosition(ByVal objChart As Excel.Chart, _
Optional ByVal sLegendPositionKey As String = "BT", _
Optional ByVal sngFontSize As Single = 10)
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objChart
'------------------
If (.HasLegend = True) Then
.Legend.Position = zReturn_LegendPosition(sLegendPositionKey)
.PlotArea.Height = .ChartArea.Height
If sLegendPositionKey = "BT" Then
'if the legend is at the bottom then move plot area up
.PlotArea.Height = .PlotArea.Height - .Legend.Height
.Legend.Left = .ChartArea.Left
.Legend.Width = .ChartArea.Width
End If
If sLegendPositionKey = "RI" Then
'if the legend is at the bottom then move plot area up
.PlotArea.Height = .PlotArea.Height - .Legend.Height
.Legend.Left = .ChartArea.Left + .ChartArea.Width
'the minus 1 is needed as is chopps of the bottom of the legend otherwise
.Legend.Height = (.ChartArea.Height - 6)
End If
End If
End With
'ensure fonts are correct after re-sizing
objChart.ChartArea.Font.Size = sngFontSize
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_LegendSizePosition", msMODULENAME, _
"adjust the size and position of the legend.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_PlotArea
Public Sub ChartFormat_PlotArea(ByVal objChart As Excel.Chart, _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal iInteriorColourIdx As Integer = 2, _
Optional ByVal sInteriorPatternStyle As String = "NO", _
Optional ByVal iFillForeColour As Integer = 0, _
Optional ByVal iFillBackColour As Integer = 0, _
Optional ByVal bFillAsSolid As Boolean = True, _
Optional ByVal sGradientColourType As String = "0", _
Optional ByVal sGradientStyle As String = "HR", _
Optional ByVal iGradientVariant As Integer = 1, _
Optional ByVal sngGradientDegree As Single = 0.5, _
Optional ByVal sGradientPresetType As String = "", _
Optional ByVal sTexturePresetType As String = "NO", _
Optional ByVal sFillPatternStyle As String = "NO")
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objChart.PlotArea
.Border.Color = iBorderColour
.Border.Weight = zReturn_BorderWeight(iBorderWeight)
.Border.LineStyle = zReturn_LineStyle(sBorderLineStyle)
' ---------------- plot area doesn't have a shadow !!
If (sTexturePresetType = "NO") And _
(sGradientColourType = "0") And (sInteriorPatternStyle = "NO") Then
.Fill.Solid()
.Interior.ColorIndex = iInteriorColourIdx
End If
If (sInteriorPatternStyle <> "NO") Then
.Interior.Pattern = zReturn_Pattern(sInteriorPatternStyle)
End If
If (sGradientColourType = "1") Then
.Fill.ForeColor.SchemeColor = iFillForeColour
End If
If (sGradientColourType = "2") Or _
((sInteriorPatternStyle <> "NO") And (sGradientColourType = "0")) Then
.Fill.ForeColor.SchemeColor = iFillForeColour
.Fill.BackColor.SchemeColor = iFillBackColour
End If
If sGradientColourType = "1" Then
.Fill.OneColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
Degree:=sngGradientDegree)
End If
If sGradientColourType = "2" Then
.Fill.TwoColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant)
End If
If sGradientColourType = "P" Then
.Fill.PresetGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
PresetGradientType:= _
zReturn_PresetGradientType(sGradientPresetType))
End If
If sTexturePresetType <> "NO" Then
.Fill.PresetTextured(PresetTexture:= _
zReturn_PresetTextureType(sTexturePresetType))
End If
If sFillPatternStyle <> "NO" Then
.Fill.Patterned(Pattern:=zReturn_PatternType(sFillPatternStyle))
End If
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_PlotAreaFormat", msMODULENAME, _
"format the plot area on the active chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_PlotAreaSizeMove
Public Sub ChartFormat_PlotAreaSizeMove(ByVal objChart As Excel.Chart, _
ByVal dbWidth As Double, _
ByVal iFromLeft As Integer, _
ByVal dbHeight As Double, _
ByVal iFromTop As Integer, _
Optional ByVal sChartName As String = "", _
Optional ByVal sWshName As String = "")
Dim objPlotArea As Excel.PlotArea
Try
If clsError.ErrorFlag() = True Then Exit Sub
'maybe split in 2 separate procedures
objPlotArea = objChart.PlotArea
With objPlotArea 'all these widths are in points !!
.Left = iFromLeft
.Width = dbWidth 'Application.UsableWidth ???
.Top = iFromTop
.Height = dbHeight 'Application.UsableHeight ???
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objPlotArea = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_PlotAreaSizeMove", msMODULENAME, _
"adjust the size and positioning of the plot area on the active chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_SeriesArea
Public Sub ChartFormat_SeriesArea(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal sSeriesName As String = "", _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal iInteriorColourIdx As Integer = 0, _
Optional ByVal sInteriorPatternStyle As String = "NO", _
Optional ByVal iFillForeColour As Integer = 0, _
Optional ByVal iFillBackColour As Integer = 0, _
Optional ByVal bFillAsSolid As Boolean = True, _
Optional ByVal sGradientColourType As String = "0", _
Optional ByVal sGradientStyle As String = "HR", _
Optional ByVal iGradientVariant As Integer = 1, _
Optional ByVal sngGradientDegree As Single = 0.5, _
Optional ByVal sGradientPresetType As String = "", _
Optional ByVal sTexturePresetType As String = "NO", _
Optional ByVal sFillPatternStyle As String = "NO")
Try
If clsError.ErrorFlag() = True Then Exit Sub
If sSeriesName <> "" Then objSeries.Name = sSeriesName
With objSeries
.Border.Color = iBorderColour
.Border.Weight = zReturn_BorderWeight(iBorderWeight)
.Border.LineStyle = zReturn_LineStyle(sBorderLineStyle)
If (sTexturePresetType = "NO") And _
(sGradientColourType = "0") And _
(sInteriorPatternStyle = "NO") Then
.Fill.Solid()
If iInteriorColourIdx = 0 Then
.Interior.ColorIndex = Colour_AreaReturn(iSeriesNo)
.Interior.Pattern = Excel.XlPattern.xlPatternSolid
End If
If iInteriorColourIdx > 0 Then
.Interior.ColorIndex = iInteriorColourIdx
.Interior.Pattern = Excel.XlPattern.xlPatternSolid
End If
End If
If (sInteriorPatternStyle <> "NO") Then
.Interior.Pattern = zReturn_Pattern(sInteriorPatternStyle)
End If
If (sGradientColourType = "1") Then
If iFillForeColour = 0 Then .Fill.ForeColor.SchemeColor = 16 + iSeriesNo
If iFillForeColour <> 0 Then .Fill.ForeColor.SchemeColor = 16 + iSeriesNo
End If
If (sGradientColourType = "2") Or _
((sInteriorPatternStyle <> "NO") And (sGradientColourType = "0")) Then
If iFillForeColour = 0 Then .Fill.ForeColor.SchemeColor = 16 + iSeriesNo
If iFillForeColour <> 0 Then .Fill.ForeColor.SchemeColor = 16 + iSeriesNo
.Fill.BackColor.SchemeColor = 16 + iSeriesNo
End If
If sGradientColourType = "1" Then
.Fill.OneColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
Degree:=sngGradientDegree)
End If
If sGradientColourType = "2" Then
.Fill.TwoColorGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant)
End If
If sGradientColourType = "P" Then
.Fill.PresetGradient(Style:=zReturn_GradientStyle(sGradientStyle), _
Variant:=iGradientVariant, _
PresetGradientType:= _
zReturn_PresetGradientType(sGradientPresetType))
End If
If sTexturePresetType <> "NO" Then
.Fill.PresetTextured(PresetTexture:= _
zReturn_PresetTextureType(sTexturePresetType))
End If
If sFillPatternStyle <> "NO" Then
.Fill.Patterned(Pattern:=zReturn_PatternType(sFillPatternStyle))
End If
End With
If ChartType_SeriesTypeIsIt3D(objSeries) = True Then
Call Chart_SeriesFormat3D(objChart, objSeries, iSeriesNo)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_SeriesAreaFormat", msMODULENAME, _
"format the 'Area' of the chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_SeriesLine
Public Sub ChartFormat_SeriesLine(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal sSeriesName As String = "")
Try
If clsError.ErrorFlag() = True Then Exit Sub
If sSeriesName <> "" Then objSeries.Name = sSeriesName
With objSeries
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_SeriesLineFormat", msMODULENAME, _
"format the 'Line' of the chart.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartFormat_TitleSizePosition
Public Sub ChartFormat_TitleSizePosition(ByVal objChart As Excel.Chart, _
Optional ByVal sLegendPositionKey As String = "BT", _
Optional ByVal sngFontSize As Single = 10)
Dim objChartArea As Excel.ChartArea
Try
If clsError.ErrorFlag() = True Then Exit Sub
objChartArea = objChart.ChartArea
With objChart
'------------------
If (.HasTitle = True) Then
.ChartTitle.Top = 1 'if there is a title put it at the top
.ChartTitle.Left = (objChartArea.Width - _
(Len(.ChartTitle.Characters.Text) * 3)) / 2
' .ChartTitle.Left = in the middle - needs to be in the middle ???????
.PlotArea.Height = .PlotArea.Height - giDEF_TITLESPACE
'height + top must always be the same !!
.PlotArea.Top = .PlotArea.Top + giDEF_TITLESPACE
End If
End With
objChartArea.Font.Size = sngFontSize 'ensure fonts are correct after re-sizing
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objChartArea = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_TitleSizePosition", msMODULENAME, _
"adjust the size and position of the title.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartHas_Legend
Public Shared Function ChartHas_Legend(ByVal objChart As Excel.Chart) As Boolean
Try
'an error occurs then there is no plot area
If objChart.Legend.Border.Color = 0 Then
ChartHasLegend = True
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
ChartHasLegend = False
End Try
End Function
ChartHas_PlotArea
Public Shared Function ChartHas_PlotArea(ByVal objChart As Excel.Chart) As Boolean
Try
'an error occurs then there is no plot area
If objChart.PlotArea.Border.Color = 0 Then
End If
ChartHas_PlotArea = True
Catch objCOMException As System.Runtime.InteropServices.COMException
ChartHasPlotArea = False
End Try
End Function
ChartHas_SeriesCollection
Public Shared Function ChartHas_SeriesCollection(ByVal objSeriesColl As Excel.SeriesCollection, _
ByVal iSeriesNo As System.Int32) As Boolean
Try
'an error occurs when the series number is valid but not plotted - eg Pie Charts
Dim objSeries As Excel.Series
objSeries = objSeriesColl.Item(iSeriesNo)
ChartSeriesExists = True
Catch objCOMException As System.Runtime.InteropServices.COMException
ChartSeriesExists = False
End Try
End Function
ChartReturns_3DBarShape
Public Function ChartReturns_3DBarShape(ByVal sBarShapeKey As String) _
As Excel.XlBarShape
Dim objtemp As Excel.XlBarShape
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sBarShapeKey
Case "BX" : objtemp = Excel.XlBarShape.xlBox
Case "CTM" : objtemp = Excel.XlBarShape.xlConeToMax
Case "CTP" : objtemp = Excel.XlBarShape.xlConeToPoint
Case "CY" : objtemp = Excel.XlBarShape.xlCylinder
Case "PTM" : objtemp = Excel.XlBarShape.xlPyramidToMax
Case "PTP" : objtemp = Excel.XlBarShape.xlPyramidToPoint
Case Else
Call MsgBox("Incorrect Border Weight abbreviation : " & _
sBarShapeKey, , _
"ChartReturns_3DBarShape")
End Select
ChartReturns_3DBarShape = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_3DBarShape", msMODULENAME, _
"return the corresponding 3D shape for the abbreviation " & _
"'" & sBarShapeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_AxisCategoryType
Public Function ChartReturns_AxisCategoryType(ByVal sAxisCategoryTypeKey As String) _
As Excel.XlCategoryType
Dim objtemp As Excel.XlCategoryType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sAxisCategoryTypeKey 'cant set this for a value chart
Case "CA" : objtemp = Excel.XlCategoryType.xlCategoryScale
Case "TS" : objtemp = Excel.XlCategoryType.xlTimeScale
Case "AS" : objtemp = Excel.XlCategoryType.xlAutomaticScale
Case Else
Call MsgBox("Incorrect Axis Category Type abbreviation : " & _
sAxisCategoryTypeKey, , _
"ChartReturns_AxesCategoryType")
End Select
ChartReturns_AxisCategoryType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_AxesCategoryType", msMODULENAME, _
"return the corresponding axis category type for the abbreviation " & _
"'" & sAxisCategoryTypeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_AxisGroup
Public Function ChartReturns_AxisGroup(ByVal sAxisGroupKey As String) _
As Excel.XlAxisGroup
Dim objtemp As Excel.XlAxisGroup
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sAxisGroupKey
Case "P" : objtemp = Excel.XlAxisGroup.xlPrimary
Case "S" : objtemp = Excel.XlAxisGroup.xlSecondary
Case Else
Call MsgBox("Incorrect Axis Group abbreviation : " & _
sAxisGroupKey, , _
"ChartReturns_AxesGroup")
End Select
ChartReturns_AxisGroup = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_AxisGroup", msMODULENAME, _
"return the corresponding axis group for the abbreviation " & _
"'" & sAxisGroupKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_AxisType
Public Function ChartReturns_AxisType(ByVal sAxisTypeKey As String) _
As Excel.XlAxisType
Dim objtemp As Excel.XlAxisType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sAxisTypeKey
Case "V" : objtemp = Excel.XlAxisType.xlValue 'the y - axis
Case "C" : objtemp = Excel.XlAxisType.xlCategory 'the x - axis
Case "S" : objtemp = Excel.XlAxisType.xlSeriesAxis 'only for 3D charts
Case Else
Call MsgBox("Incorrect Axis Type abbreviation : " & _
sAxisTypeKey, , _
"ChartReturns_AxisType")
End Select
ChartReturns_AxisType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_AxisType", msMODULENAME, _
"return the corresponding axis type for the abbreviation " & _
"'" & sAxisTypeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_Background
Public Function ChartReturns_Background(ByVal sBackgroundKey As String) _
As Excel.XlBackground
Dim objtemp As Excel.XlBackground
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sBackgroundKey
Case "AU" : objtemp = Excel.XlBackground.xlBackgroundAutomatic
Case "OP" : objtemp = Excel.XlBackground.xlBackgroundOpaque
Case "TR" : objtemp = Excel.XlBackground.xlBackgroundTransparent
Case Else
Call MsgBox("Incorrect Background abbreviation : " & _
sBackgroundKey, , _
"ChartReturns_BackgroundType")
End Select
ChartReturns_Background = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_Background", msMODULENAME, _
"return the corresponding background type for the abbreviation " & _
"'" & sBackgroundKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_BorderWeight
Public Function ChartReturns_BorderWeight(ByVal sBorderWeightKey As Integer) _
As Excel.XlBorderWeight
Dim objtemp As Excel.XlBorderWeight
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sBorderWeightKey
Case 1 : objtemp = Excel.XlBorderWeight.xlHairline
Case 2 : objtemp = Excel.XlBorderWeight.xlThin
Case 3 : objtemp = Excel.XlBorderWeight.xlMedium
Case 4 : objtemp = Excel.XlBorderWeight.xlThick
Case Else
Call MsgBox("Incorrect Border Weight number : " & _
sBorderWeightKey, , _
"ChartReturns_BorderWeight")
End Select
ChartReturns_BorderWeight = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_BorderWeight", msMODULENAME, _
"return the corresponding border weight for the abbreviation " & _
"'" & sBorderWeightKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_DataLabelPosition
Public Function ChartReturns_DataLabelPosition(ByVal sDataLabelPosKey As String) _
As Excel.XlDataLabelPosition
Dim objtemp As Excel.XlDataLabelPosition
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sDataLabelPosKey
Case "AB" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionAbove
Case "BL" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionBelow
Case "BF" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionBestFit
Case "CT" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionCenter
Case "CU" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionCustom
Case "IB" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionInsideBase
Case "IE" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionInsideEnd
Case "LF" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionLeft
Case "MX" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionMixed
Case "OE" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionOutsideEnd
Case "RI" : objtemp = Excel.XlDataLabelPosition.xlLabelPositionRight
Case Else
Call MsgBox("Incorrect Data Label Position abbreviation : " & _
sDataLabelPosKey, , _
"ChartReturns_DataLabelPosition")
End Select
ChartReturns_DataLabelPosition = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_DataLabelPosition", msMODULENAME, _
"return the corresponding data label position for the abbreviation " & _
"'" & sDataLabelPosKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_DataLabelsType
Public Function ChartReturns_DataLabelsType(ByVal sDataLabelTypeKey As String) _
As Excel.XlDataLabelsType
Dim objtemp As Excel.XlDataLabelsType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sDataLabelTypeKey
Case "NO" : objtemp = Excel.XlDataLabelsType.xlDataLabelsShowNone
Case "VA" : objtemp = Excel.XlDataLabelsType.xlDataLabelsShowValue
Case "PC" : objtemp = Excel.XlDataLabelsType.xlDataLabelsShowPercent
Case "LB" : objtemp = Excel.XlDataLabelsType.xlDataLabelsShowLabel
Case "LBPC" : objtemp = Excel.XlDataLabelsType.xlDataLabelsShowLabelAndPercent
Case Else
Call MsgBox("Incorrect Data Label Type abbreviation : " & _
sDataLabelTypeKey, , _
"ChartReturns_DataLabelPosition")
End Select
ChartReturns_DataLabelsType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_DataLabelsType", msMODULENAME, _
"return the corresponding data label type for the abbreviation " & _
"'" & sDataLabelTypeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_FontName
Public Function ChartReturns_FontName(ByVal sFontNameKey As String) _
As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim stemp As String
If sFontNameKey = "" Then sFontNameKey = "AR"
Select Case sFontNameKey
Case "UN" : stemp = "UniversLight"
Case "AR" : stemp = "Arial"
Case "HL" : stemp = "Helvetica"
Case "TN" : stemp = "Times New Roman"
Case "AN" : stemp = "ArialNarrow"
Case "AB" : stemp = "Arial Black"
Case "SB" : stemp = "Sabon"
Case "MS" : stemp = "Monotype sorts"
Case "VB" : stemp = "VeticaBlack"
Case Else
Call MsgBox("Incorrect Font Name abbreviation : " & _
sFontNameKey, , _
"ChartReturns_FontName")
End Select
ChartReturns_FontName = stemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_FontName", msMODULENAME, _
"return the corresponding font name for the abbreviation " & _
"'" & sFontNameKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_GradientStyle
Public Function ChartReturns_GradientStyle(ByVal sGradientStyleKey As String) _
As Office.MsoGradientStyle
Dim objtemp As Office.MsoGradientStyle
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sGradientStyleKey
Case "DDW" : objtemp = Office.MsoGradientStyle.msoGradientDiagonalDown
Case "DUP" : objtemp = Office.MsoGradientStyle.msoGradientDiagonalUp
Case "FCE" : objtemp = Office.MsoGradientStyle.msoGradientFromCenter
Case "FCR" : objtemp = Office.MsoGradientStyle.msoGradientFromCorner
Case "HR" : objtemp = Office.MsoGradientStyle.msoGradientHorizontal
Case "VR" : objtemp = Office.MsoGradientStyle.msoGradientVertical
Case "MX" : objtemp = Office.MsoGradientStyle.msoGradientMixed
Case Else
Call MsgBox("Incorrect Gradient Style abbreviation : " & _
sGradientStyleKey, , _
"ChartReturns_GradientStyle")
End Select
ChartReturns_GradientStyle = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_GradientStyle", msMODULENAME, _
"return the corresponding gradient style for the abbreviation " & _
"'" & sGradientStyleKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_LegendPosition
Public Function ChartReturns_LegendPosition(ByVal sLegendPositionKey As String) _
As Excel.XlLegendPosition
Dim objtemp As Excel.XlLegendPosition
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sLegendPositionKey
Case "TP" : objtemp = Excel.XlLegendPosition.xlLegendPositionTop
Case "BT" : objtemp = Excel.XlLegendPosition.xlLegendPositionBottom
Case "RI" : objtemp = Excel.XlLegendPosition.xlLegendPositionRight
Case "LF" : objtemp = Excel.XlLegendPosition.xlLegendPositionLeft
Case "CR" : objtemp = Excel.XlLegendPosition.xlLegendPositionCorner
Case Else
Call MsgBox("Incorrect Legend Position abbreviation : " & _
sLegendPositionKey, , _
"ChartReturns_LegendPosition")
End Select
ChartReturns_LegendPosition = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_LegendPosition", msMODULENAME, _
"return the corresponding legend position for the abbreviation " & _
"'" & sLegendPositionKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_LineStyle
Public Function ChartReturns_LineStyle(ByVal sLineStyleKey As String) _
As Excel.XlLineStyle
Dim objtemp As Excel.XlLineStyle
Try
If clsError.ErrorFlag() = True Then Exit Function
'Case "AU" : ltemporary = Excel.XlLineStyle.xlAutomatic
Select Case sLineStyleKey
Case "NO" : objtemp = Excel.XlLineStyle.xlLineStyleNone 'xlNone
Case "CT" : objtemp = Excel.XlLineStyle.xlContinuous
Case "DS" : objtemp = Excel.XlLineStyle.xlDash
Case "DT" : objtemp = Excel.XlLineStyle.xlDot
Case "DDT" : objtemp = Excel.XlLineStyle.xlDashDot
Case "DDD" : objtemp = Excel.XlLineStyle.xlDashDotDot
Case "DBL" : objtemp = Excel.XlLineStyle.xlDouble
Case "SDD" : objtemp = Excel.XlLineStyle.xlSlantDashDot
'Case "G25" : objtemporary = -4124 'Excel.XlLineStyle.xlGray25
'Case "G50" : objtemporary = -4125 'Excel.XlLineStyle.xlGray50
'Case "G75" : objtemporary = -4126 'Excel.XlLineStyle.xlGray75
Case Else
Call MsgBox("Incorrect Line Style : " & sLineStyleKey, , _
"ChartReturns_LineStyle")
End Select
ChartReturns_LineStyle = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_LineStyle", msMODULENAME, _
"return the corresponding line style for the abbreviation " & _
"'" & sLineStyleKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_MarkerStyle
Public Function ChartReturns_MarkerStyle(ByVal sMarkerStyleKey As String) _
As Excel.XlMarkerStyle
Dim objtemp As Excel.XlMarkerStyle
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sMarkerStyleKey
Case "NO" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleNone
Case "AU" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleAutomatic
Case "SQ" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleSquare
Case "DI" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleDiamond
Case "TR" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleTriangle
Case "XX" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleX
Case "ST" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleStar
Case "DT" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleDot
Case "DS" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleDash
Case "CR" : objtemp = Excel.XlMarkerStyle.xlMarkerStyleCircle
Case "PL" : objtemp = Excel.XlMarkerStyle.xlMarkerStylePlus
Case Else
Call MsgBox("Incorrect Marker Style abbreviation : " & _
sMarkerStyleKey, , _
"ChartReturns_MarkerStyle")
End Select
ChartReturns_MarkerStyle = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_MarkerStyle", msMODULENAME, _
"return the corresponding marker style for the abbreviation " & _
"'" & sMarkerStyleKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_Pattern
Public Function ChartReturns_Pattern(ByVal sPatternKey As String) _
As Excel.XlPattern
Dim objtemp As Excel.XlPattern
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sPatternKey
Case "NO" : objtemp = Excel.XlPattern.xlPatternNone
Case "SLD" : objtemp = Excel.XlPattern.xlPatternSolid
Case "SD" : objtemp = Excel.XlPattern.xlPatternSolid
Case "AU" : objtemp = Excel.XlPattern.xlPatternAutomatic
Case "CH" : objtemp = Excel.XlPattern.xlPatternChecker
Case "CC" : objtemp = Excel.XlPattern.xlPatternCrissCross
Case "G16" : objtemp = Excel.XlPattern.xlPatternGray16
Case "G25" : objtemp = Excel.XlPattern.xlPatternGray25
Case "G50" : objtemp = Excel.XlPattern.xlPatternGray50
Case "G75" : objtemp = Excel.XlPattern.xlPatternGray75
Case "G8" : objtemp = Excel.XlPattern.xlPatternGray8
Case "GR" : objtemp = Excel.XlPattern.xlPatternGrid
Case "UP" : objtemp = Excel.XlPattern.xlPatternUp
Case "DN" : objtemp = Excel.XlPattern.xlPatternDown
Case "HR" : objtemp = Excel.XlPattern.xlPatternHorizontal
Case "VT" : objtemp = Excel.XlPattern.xlPatternVertical
Case "LU" : objtemp = Excel.XlPattern.xlPatternLightUp
Case "LD" : objtemp = Excel.XlPattern.xlPatternLightDown
Case "LH" : objtemp = Excel.XlPattern.xlPatternLightHorizontal
Case "LV" : objtemp = Excel.XlPattern.xlPatternLightVertical
Case "SG75" : objtemp = Excel.XlPattern.xlPatternSemiGray75
Case Else
Call MsgBox("Incorrect Pattern Style abbreviation : " & _
sPatternKey, , _
"ChartReturns_Pattern")
End Select
ChartReturns_Pattern = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_Pattern", msMODULENAME, _
"return the corresponding pattern for the abbreviation " & _
"'" & sPatternKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_PatternType
Public Function ChartReturns_PatternType(ByVal sPatternTypeKey As String) _
As Office.MsoPatternType
Dim objtemp As Office.MsoPatternType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sPatternTypeKey
Case "5P" : objtemp = Office.MsoPatternType.msoPattern5Percent
Case "10P" : objtemp = Office.MsoPatternType.msoPattern10Percent
Case "20P" : objtemp = Office.MsoPatternType.msoPattern20Percent
Case "25P" : objtemp = Office.MsoPatternType.msoPattern25Percent
Case "30P" : objtemp = Office.MsoPatternType.msoPattern30Percent
Case "40P" : objtemp = Office.MsoPatternType.msoPattern40Percent
Case "50P" : objtemp = Office.MsoPatternType.msoPattern50Percent
Case "60P" : objtemp = Office.MsoPatternType.msoPattern60Percent
Case "70P" : objtemp = Office.MsoPatternType.msoPattern70Percent
Case "75P" : objtemp = Office.MsoPatternType.msoPattern75Percent
Case "80P" : objtemp = Office.MsoPatternType.msoPattern80Percent
Case "90P" : objtemp = Office.MsoPatternType.msoPattern90Percent
Case "DRKDWDI" : objtemp = Office.MsoPatternType.msoPatternDarkDownwardDiagonal
Case "LHTDWDI" : objtemp = Office.MsoPatternType.msoPatternLightDownwardDiagonal
Case "WDEDWDI" : objtemp = Office.MsoPatternType.msoPatternWideDownwardDiagonal
Case "DSHDWDI" : objtemp = Office.MsoPatternType.msoPatternDashedDownwardDiagonal
Case "DRKUPDI" : objtemp = Office.MsoPatternType.msoPatternDarkUpwardDiagonal
Case "LHTUPDI" : objtemp = Office.MsoPatternType.msoPatternLightUpwardDiagonal
Case "WDEUPDI" : objtemp = Office.MsoPatternType.msoPatternWideUpwardDiagonal
Case "DSHUPDI" : objtemp = Office.MsoPatternType.msoPatternDashedUpwardDiagonal
Case "DRKHR" : objtemp = Office.MsoPatternType.msoPatternDarkHorizontal
Case "LHTHR" : objtemp = Office.MsoPatternType.msoPatternLightHorizontal
Case "NRWHR" : objtemp = Office.MsoPatternType.msoPatternNarrowHorizontal
Case "DRKVR" : objtemp = Office.MsoPatternType.msoPatternDarkVertical
Case "LHTVR" : objtemp = Office.MsoPatternType.msoPatternLightVertical
Case "NRWVR" : objtemp = Office.MsoPatternType.msoPatternNarrowVertical
Case "DSHVR" : objtemp = Office.MsoPatternType.msoPatternDashedVertical
Case "DSHHR" : objtemp = Office.MsoPatternType.msoPatternDashedHorizontal
Case "DIABR" : objtemp = Office.MsoPatternType.msoPatternDiagonalBrick
Case "DTDGR" : objtemp = Office.MsoPatternType.msoPatternDottedGrid
Case "HRBR" : objtemp = Office.MsoPatternType.msoPatternHorizontalBrick
Case "LRGCHBD" : objtemp = Office.MsoPatternType.msoPatternLargeCheckerBoard
Case "SMLCHBD" : objtemp = Office.MsoPatternType.msoPatternSmallCheckerBoard
Case "LRGCON" : objtemp = Office.MsoPatternType.msoPatternLargeConfetti
Case "SMLCON" : objtemp = Office.MsoPatternType.msoPatternSmallConfetti
Case "LRGGR" : objtemp = Office.MsoPatternType.msoPatternLargeGrid
Case "SMLGR" : objtemp = Office.MsoPatternType.msoPatternSmallGrid
Case "MX" : objtemp = Office.MsoPatternType.msoPatternMixed
Case "TR" : objtemp = Office.MsoPatternType.msoPatternTrellis
Case "WE" : objtemp = Office.MsoPatternType.msoPatternWeave
'Case "" : objtemp = Office.MsoPatternType.msoPatternLightDiamonds
'Case "" : objtemp = Office.MsoPatternType.msoPatternOutlinedDiamonds
'Case "" : objtemp = Office.MsoPatternType.msoPatternPlaidmsoPatternShingles
'Case "" : objtemp = Office.MsoPatternType.msoPatternSolidDiamonds
'Case "" : objtemp = Office.MsoPatternType.msoPatternSpheres
'Case "" : objtemp = Office.MsoPatternType.msoPatternWaves
'Case "" : objtemp = Office.MsoPatternType.msoPatternWavyLines
'Case "" : objtemp = Office.MsoPatternType.msoPatternDivits
Case Else
Call MsgBox("Incorrect Pattern Style abbreviation : " & _
sPatternTypeKey, , _
"ChartReturns_PatternStyle")
End Select
ChartReturns_PatternType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_PatternType", msMODULENAME, _
"return the corresponding pattern type for the abbreviation " & _
"'" & sPatternTypeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_PresetGradientType
Public Function ChartReturns_PresetGradientType(ByVal sPresetGradientStyleKey As String) _
As Office.MsoPresetGradientType
Dim objtemp As Office.MsoPresetGradientType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sPresetGradientStyleKey
Case "BRS" : objtemp = Office.MsoPresetGradientType.msoGradientBrass
Case "CLM" : objtemp = Office.MsoPresetGradientType.msoGradientCalmWater
Case "CHR" : objtemp = Office.MsoPresetGradientType.msoGradientChrome
Case "CHR2" : objtemp = Office.MsoPresetGradientType.msoGradientChromeII
Case "DYB" : objtemp = Office.MsoPresetGradientType.msoGradientDaybreak
Case "DES" : objtemp = Office.MsoPresetGradientType.msoGradientDesert
Case "ESS" : objtemp = Office.MsoPresetGradientType.msoGradientEarlySunset
Case "FIR" : objtemp = Office.MsoPresetGradientType.msoGradientFire
Case "FOG" : objtemp = Office.MsoPresetGradientType.msoGradientFog
Case "GLD" : objtemp = Office.MsoPresetGradientType.msoGradientGold
Case "GLD2" : objtemp = Office.MsoPresetGradientType.msoGradientGoldII
Case "HR" : objtemp = Office.MsoPresetGradientType.msoGradientHorizon
Case "LSS" : objtemp = Office.MsoPresetGradientType.msoGradientLateSunset
Case "MAH" : objtemp = Office.MsoPresetGradientType.msoGradientMahogany
Case "MOS" : objtemp = Office.MsoPresetGradientType.msoGradientMoss
Case "NFL" : objtemp = Office.MsoPresetGradientType.msoGradientNightfall
Case "OCN" : objtemp = Office.MsoPresetGradientType.msoGradientOcean
Case "PAR" : objtemp = Office.MsoPresetGradientType.msoGradientParchment
Case "PCK" : objtemp = Office.MsoPresetGradientType.msoGradientPeacock
Case "RNB" : objtemp = Office.MsoPresetGradientType.msoGradientRainbow
Case "RNB2" : objtemp = Office.MsoPresetGradientType.msoGradientRainbowII
Case "SAP" : objtemp = Office.MsoPresetGradientType.msoGradientSapphire
Case "SLV" : objtemp = Office.MsoPresetGradientType.msoGradientSilver
Case "WHT" : objtemp = Office.MsoPresetGradientType.msoGradientWheat
Case "MX" : objtemp = Office.MsoPresetGradientType.msoPresetGradientMixed
Case Else
Call MsgBox("Incorrect Gradient Style abbreviation : " & _
sPresetGradientStyleKey, , _
"ChartReturns_PresetGradientType")
End Select
ChartReturns_PresetGradientType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_GradientType", msMODULENAME, _
"return the corresponding preset gradient style for the abbreviation " & _
"'" & sPresetGradientStyleKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_PresetTextureType
Public Function ChartReturns_PresetTextureType(ByVal sPresetTextureTypeKey As String) _
As Office.MsoPresetTexture
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim objtemp As Office.MsoPresetTexture
Select Case sPresetTextureTypeKey
Case "BRM" : objtemp = Office.MsoPresetTexture.msoTextureBrownMarble
Case "COR" : objtemp = Office.MsoPresetTexture.msoTextureCork
Case "GRN" : objtemp = Office.MsoPresetTexture.msoTextureGranite
Case "GRM" : objtemp = Office.MsoPresetTexture.msoTextureGreenMarble
Case "MDW" : objtemp = Office.MsoPresetTexture.msoTextureMediumWood
Case "OAK" : objtemp = Office.MsoPresetTexture.msoTextureOak
Case "SND" : objtemp = Office.MsoPresetTexture.msoTextureSand
Case "WLN" : objtemp = Office.MsoPresetTexture.msoTextureWalnut
Case "WTM" : objtemp = Office.MsoPresetTexture.msoTextureWhiteMarble
Case "WMT" : objtemp = Office.MsoPresetTexture.msoTextureWovenMat
' Case "PTM": objtemp = Microsoft.Office.Core.MsoPresetTexture.msoPresetTextureMixed
' Case "": objtemp = Microsoft.Office.Core.MsoPresetTexture.msoTextureCloth
' Case "": objtemp = Microsoft.Office.Core.MsoPresetTexture.msoTexturePaper
Case Else
Call MsgBox("Incorrect Marker Style abbreviation : " & _
sPresetTextureTypeKey, , _
"ChartReturns_PresetTextureType")
End Select
ChartReturns_PresetTextureType = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_PresetTextureType", msMODULENAME, _
"return the corresponding preset texture type for the abbreviation " & _
"'" & sPresetTextureTypeKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_TickLabelOrientation
Public Function ChartReturns_TickLabelOrientation(ByVal sTickLabelOrientationKey As String) _
As Excel.XlTickLabelOrientation
Dim objtemp As Excel.XlTickLabelOrientation
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sTickLabelOrientationKey
Case "AU" : objtemp = Excel.XlTickLabelOrientation.xlTickLabelOrientationAutomatic
Case "DW" : objtemp = Excel.XlTickLabelOrientation.xlTickLabelOrientationDownward
Case "HR" : objtemp = Excel.XlTickLabelOrientation.xlTickLabelOrientationHorizontal
Case "AP" : objtemp = Excel.XlTickLabelOrientation.xlTickLabelOrientationUpward
Case "VR" : objtemp = Excel.XlTickLabelOrientation.xlTickLabelOrientationVertical
Case Else
Call MsgBox("Incorrect Tick Label Orientation abbreviation : " & _
sTickLabelOrientationKey, , _
"ChartReturns_TickLabelOrientation")
End Select
ChartReturns_TickLabelOrientation = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_TickLabelOrientation", msMODULENAME, _
"return the corresponding tick label orientation for the abbreviation " & _
"'" & sTickLabelOrientationKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_TickLabelPosition
Public Function ChartReturns_TickLabelPosition(ByVal sTickLabelPositionKey As String) _
As Excel.XlTickLabelPosition
Dim objtemp As Excel.XlTickLabelPosition
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sTickLabelPositionKey
Case "NO" : objtemp = Excel.XlTickLabelPosition.xlTickLabelPositionNone
Case "LW" : objtemp = Excel.XlTickLabelPosition.xlTickLabelPositionLow
Case "HI" : objtemp = Excel.XlTickLabelPosition.xlTickLabelPositionHigh
Case "NA" : objtemp = Excel.XlTickLabelPosition.xlTickLabelPositionNextToAxis
Case Else
Call MsgBox("Incorrect Tick Label Position abbreviation : " & _
sTickLabelPositionKey, , _
"ChartReturns_TickLabelPosition")
End Select
ChartReturns_TickLabelPosition = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_TickLabelPosition", msMODULENAME, _
"return the corresponding tick label position for the abbreviation " & _
"'" & sTickLabelPositionKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_TickMarkPosition
Public Function ChartReturns_TickMarkPosition(ByVal sTickMarkPositionKey As String) _
As Excel.XlTickMark
Dim objtemp As Excel.XlTickMark
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sTickMarkPositionKey
Case "NO" : objtemp = Excel.XlTickMark.xlTickMarkNone
Case "OU" : objtemp = Excel.XlTickMark.xlTickMarkOutside
Case "IN" : objtemp = Excel.XlTickMark.xlTickMarkInside
Case "CR" : objtemp = Excel.XlTickMark.xlTickMarkCross
Case Else
Call MsgBox("Incorrect Tick Mark Position abbreviation : " & _
sTickMarkPositionKey, , _
"ChartReturns_TickMarkPosition")
End Select
ChartReturns_TickMarkPosition = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_TickMarkPosition", msMODULENAME, _
"return the corresponding tick mark position for the abbreviation " & _
"'" & sTickMarkPositionKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_TimeSeriesUnit
Public Function ChartReturns_TimeSeriesUnit(ByVal sTimeSeriesUnitKey As String) _
As Excel.XlTimeUnit
Dim objtemp As Excel.XlTimeUnit
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sTimeSeriesUnitKey
Case "D" : objtemp = Excel.XlTimeUnit.xlDays
Case "M" : objtemp = Excel.XlTimeUnit.xlMonths
Case "Y" : objtemp = Excel.XlTimeUnit.xlYears
Case Else
Call MsgBox("Incorrect Time Series Base abbreviation : " & _
sTimeSeriesUnitKey, , _
"ChartReturns_TimeSeriesBase")
End Select
ChartReturns_TimeSeriesUnit = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_TimeSeriesUnit", msMODULENAME, _
"return the corresponding time series unit for the abbreviation " & _
"'" & sTimeSeriesUnitKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartReturns_UnderlineStyle
Public Function ChartReturns_UnderlineStyle(ByVal sUnderlineStyleKey As String) _
As Excel.XlUnderlineStyle
Dim objtemp As Excel.XlUnderlineStyle
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sUnderlineStyleKey
Case "NO" : objtemp = Excel.XlUnderlineStyle.xlUnderlineStyleNone
Case "SN" : objtemp = Excel.XlUnderlineStyle.xlUnderlineStyleSingle
Case "DB" : objtemp = Excel.XlUnderlineStyle.xlUnderlineStyleDouble
Case Else
Call MsgBox("Incorrect Underline abbreviation : " & _
sUnderlineStyleKey, , _
"ChartReturns_BackgroundType")
End Select
ChartReturns_UnderlineStyle = objtemp
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objtemp = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartReturns_UnderlineType", msMODULENAME, _
"return the corresponding underline type for the abbreviation " & _
"'" & sUnderlineStyleKey & "'.", _
gobjCOMException, gobjException)
End If
End Try
End Function
ChartSeries_AxisChange
Public Sub ChartSeries_AxisChange(ByVal objSeries As Excel.Series, _
ByVal sAxisGroup As String)
Try
If clsError.ErrorFlag() = True Then Exit Sub
If sAxisGroup = "P" Then objSeries.AxisGroup = Excel.XlAxisGroup.xlPrimary
If sAxisGroup = "S" Then objSeries.AxisGroup = Excel.XlAxisGroup.xlSecondary
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartSeries_AxisChange", msMODULENAME, _
"change the axis that series " & objSeries.Name & " is using.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartSeries_AxisUsed
Public Function ChartSeries_AxisUsed(ByVal objSeries As Excel.Series) _
As String
Try
If clsError.ErrorFlag() = True Then Exit Function
If objSeries.AxisGroup = Excel.XlAxisGroup.xlPrimary Then
ChartSeries_AxisUsed = "P"
End If
If objSeries.AxisGroup = Excel.XlAxisGroup.xlSecondary Then
ChartSeries_AxisUsed = "S"
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartSeries_AxisUsed", msMODULENAME, _
"return the axis that series " & objSeries.Name & " is using.", _
gobjCOMException, gobjException)
End If
End Try
End Function
'****************************************************************************************
ChartSeries_Format
Public Sub ChartSeries_Format(ByVal objChart As Excel.Chart, _
ByVal sFormatType As String, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim iser As Integer
iser = iSeriesNo
Select Case objSeries.ChartType.ToString & _
Space(26 - objSeries.ChartType.ToString.Length)
Case "xlColumnClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlColumnStacked " : ChartSeries_FormatStacked(objChart, objSeries, iser)
Case "xlColumnStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xl3DColumnClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xl3DColumnStacked " : ChartSeries_FormatStacked(objChart, objSeries, iser)
Case "xl3DColumnStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xl3DColumn " : ChartSeries_FormatColumn(objChart, objSeries, iser)
'---------------------------------------------
Case "xlBarClustered " : ChartSeries_FormatBar(objChart, objSeries, iser)
Case "xlBarStacked " : ChartSeries_FormatStacked(objChart, objSeries, iser)
Case "xlBarStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xl3DBarClustered " : ChartSeries_FormatBar(objChart, objSeries, iser)
Case "xl3DBarStacked " : ChartSeries_FormatStacked(objChart, objSeries, iser)
Case "xl3DBarStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
'---------------------------------------------
Case "xlLine " : ChartSeries_FormatLine(objChart, objSeries, iser)
Case "xlLineStacked " : ChartSeries_FormatLine(objChart, objSeries, iser)
Case "xlLineStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xlLineMarkers " : ChartSeries_FormatLine(objChart, objSeries, iser)
Case "xlLineMarkersStacked " : ChartSeries_FormatLine(objChart, objSeries, iser)
Case "xlLineMarkersStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xl3DLine " : ChartSeries_FormatLine(objChart, objSeries, iser)
'---------------------------------------------
Case "xlPie " : ChartSeries_FormatPie(objChart, objSeries, iser)
Case "xlPieExploded " : ChartSeries_FormatPie(objChart, objSeries, iser)
Case "xlPieOfPie " : ChartSeries_FormatPie(objChart, objSeries, iser)
Case "xl3DPie " : ChartSeries_FormatPie(objChart, objSeries, iser)
Case "xl3DPieExploded " : ChartSeries_FormatPie(objChart, objSeries, iser)
Case "xlBarOfPie " : ChartSeries_FormatBar(objChart, objSeries, iser)
'---------------------------------------------
Case "xlXYScatter " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlXYScatterLines " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlXYScatterLinesNoMarkers " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlXYScatterSmooth " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlXYScatterSmoothNoMarkers" : ChartSeries_FormatScatter(objChart, objSeries, iser)
'---------------------------------------------
Case "xlArea " : ChartSeries_FormatArea(objChart, objSeries, iser)
Case "xlAreaStacked " : ChartSeries_FormatArea(objChart, objSeries, iser)
Case "xlAreaStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
Case "xl3DArea " : ChartSeries_FormatArea(objChart, objSeries, iser)
Case "xl3DAreaStacked " : ChartSeries_FormatArea(objChart, objSeries, iser)
Case "xl3DAreaStacked100 " : ChartSeries_FormatStacked100(objChart, objSeries, iser)
'---------------------------------------------
Case "xlDoughnut " : ChartSeries_FormatDoughnut(objChart, objSeries, iser)
Case "xlDoughnutExploded " : ChartSeries_FormatDoughnut(objChart, objSeries, iser)
'---------------------------------------------
Case "xlRadar " : ChartSeries_FormatRadar(objChart, objSeries, iser)
Case "xlRadarMarkers " : ChartSeries_FormatRadar(objChart, objSeries, iser)
'xlRadarFilled - is nto recognised - -4111 ??
Case "xlRadarFilled " ': Chart_SeriesFormatRadar(objChart, objSeries, iser)
'---------------------------------------------
Case "xlSurface " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlSurfaceWireframe " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlSurfaceTopView " : ChartSeries_FormatScatter(objChart, objSeries, iser)
Case "xlSurfaceTopViewWireframe " : ChartSeries_FormatScatter(objChart, objSeries, iser)
'---------------------------------------------
Case "xlBubble " : ChartSeries_FormatBubble(objChart, objSeries, iser)
Case "xlBubble3DEffect " : ChartSeries_FormatBubble(objChart, objSeries, iser)
'---------------------------------------------
Case "xlStockHLC " : ChartSeries_FormatStock(objChart, objSeries, iser)
Case "xlStockVHLC " : ChartSeries_FormatStock(objChart, objSeries, iser)
Case "xlStockOHLC " : ChartSeries_FormatStock(objChart, objSeries, iser)
Case "xlStockVOHLC " : ChartSeries_FormatStock(objChart, objSeries, iser)
'---------------------------------------------
Case "xlCylinderCol " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderBarClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderBarStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderBarStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderColClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderColStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlCylinderColStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
'---------------------------------------------
Case "xlConeBarClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeBarStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeBarStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeCol " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeColClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeColStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlConeColStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
'---------------------------------------------
Case "xlPyramidBarClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidBarStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidBarStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidCol " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidColClustered " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidColStacked " : ChartSeries_FormatColumn(objChart, objSeries, iser)
Case "xlPyramidColStacked100 " : ChartSeries_FormatColumn(objChart, objSeries, iser)
'---------------------------------------------
Case "-4111 "
'This also occurs when you get the chart type of a "xlRadarFilled"
'This occurs if you try and get the type of a series on a Stock chart
'---------------------------------------------
'Case xlBar : Call Chart_SeriesFormatColumn(idef, iser)
'Case xl3DBar : Call Chart_SeriesFormatBar(idef, iser)
'Case xlCylinder : Call Chart_SeriesFormatColumn(idef, iser)
Case Else
Call MsgBox( _
" chart type " = "" & objSeries.ChartType.ToString & """ is not valid!")
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesFormat", msMODULENAME, _
"format series " & iSeriesNo & " which has chart type ???" & _
" on the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_Format_LineOrArea
Public Sub ChartSeries_Format_LineOrArea(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim iser As Integer
iser = iSeriesNo
Select Case objSeries.ChartType.ToString & _
Space(26 - objSeries.ChartType.ToString.Length)
Case "xlColumnClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlColumnStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlColumnStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DColumnClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DColumnStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DColumnStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DColumn " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlBarClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlBarStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlBarStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DBarClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DBarStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DBarStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlLine " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlLineStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlLineStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlLineMarkers " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlLineMarkersStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlLineMarkersStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DLine " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlPie " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPieExploded " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPieOfPie " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DPie " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DPieExploded " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlBarOfPie " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlXYScatter " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlXYScatterLines " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlXYScatterLinesNoMarkers " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlXYScatterSmooth " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlXYScatterSmoothNoMarkers" : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlArea " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlAreaStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlAreaStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DArea " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DAreaStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xl3DAreaStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlDoughnut " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlDoughnutExploded " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlRadar " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlRadarMarkers " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlRadarFilled " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
'This is not possible ???
Case "xlSurface " ': Chart_SeriesAreaFormat(objChart, objSeries, iser)
Case "xlSurfaceWireframe " ': Chart_SeriesLineFormat(objChart, objSeries, iser)
Case "xlSurfaceTopView " ': Chart_SeriesAreaFormat(objChart, objSeries, iser)
Case "xlSurfaceTopViewWireframe " ': Chart_SeriesLineFormat(objChart, objSeries, iser)
'---------------------------------------------
Case "xlBubble " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlBubble3DEffect " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlStockHLC " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlStockVHLC " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlStockOHLC " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlStockVOHLC " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlCylinderCol " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderBarClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderBarStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderBarStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderColClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderColStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlCylinderColStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlConeBarClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeBarStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeBarStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeCol " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeColClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeColStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlConeColStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "xlPyramidBarClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidBarStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidBarStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidCol " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidColClustered " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidColStacked " : ChartFormat_SeriesArea(objChart, objSeries, iser)
Case "xlPyramidColStacked100 " : ChartFormat_SeriesArea(objChart, objSeries, iser)
'---------------------------------------------
Case "-4111 "
'---------------------------------------------
Case Else
Call MsgBox( _
" chart type '" & objSeries.ChartType.ToString & "' is not valid !")
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesFormatLineOrArea", msMODULENAME, _
"format series " & iSeriesNo & " which has chart type " & _
objSeries.ChartType.ToString & _
" on the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_Format3D
Public Sub ChartSeries_Format3D(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
'With objChart
' .Elevation = 15
' .Rotation = 20
'End With
'if its a 3D bar chart then
'can specify the bar shape
' .BarShape = Return_3DBarShape("")
'call format_flooroptions
'call format_wallsoptions
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_Format3D", msMODULENAME, _
"apply the customised '3D' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatArea
Public Sub ChartSeries_FormatArea(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objSeries
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatArea", msMODULENAME, _
"apply the customised 'Area' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatBar
Public Sub ChartSeries_FormatBar(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iGapWidth As Integer = 100, _
Optional ByVal bHasSeriesLine As Boolean = False, _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iOverlapWidth As Integer = 0, _
Optional ByVal bVaryByCategories As Boolean = False, _
Optional ByVal iChartDepth As Integer = 150, _
Optional ByVal iGapDepth As Integer = 100)
Dim objChartGroup As Excel.ChartGroup
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objSeries
.Shadow = bShadow
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.Overlap = iOverlapWidth
.GapWidth = iGapWidth
.HasSeriesLines = bHasSeriesLine
.VaryByCategories = bVaryByCategories
End With
End With
If ChartType_SeriesTypeIsIt3D(objSeries) = True Then _
Call ChartSeries_Format3D(objChart, objSeries, iSeriesNo)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatBar", msMODULENAME, _
"apply the customised 'Bar' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatBubble
Public Sub ChartSeries_FormatBubble(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal iInteriorColourIdx As Integer = 0, _
Optional ByVal bHas3DEffect As Boolean = True)
Dim objChartGroup As Excel.ChartGroup
Try
If clsError.ErrorFlag() = True Then Exit Sub
If objChart.HasLegend = True Then objChart.Legend.Delete()
With objSeries
.Border.Color = iBorderColour
.Border.Weight = ChartReturns_BorderWeight(iBorderWeight)
.Border.LineStyle = ChartReturns_LineStyle(sBorderLineStyle)
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.ShowNegativeBubbles = False
.SizeRepresents = Excel.XlSizeRepresents.xlSizeIsArea
.BubbleScale = 100
End With
.Has3DEffect = bHas3DEffect 'is negative - greyed out
End With
' '.ErrorBar Direction:=xlX, Include:=xlMinusValues, Type:=xlFixedValue, Amount:=5
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatBubble", msMODULENAME, _
"apply the customised 'Bubble' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatClustered
Public Sub ChartSeries_FormatClustered(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatClustered", msMODULENAME, _
"apply the customised 'Clustered' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatColumn
Public Sub ChartSeries_FormatColumn(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iBorderColourIdx As Integer = giDEF_PALETTEAXESCOLOUR, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal iGapWidth As Integer = 100, _
Optional ByVal bHasSeriesLine As Boolean = False, _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iOverlapWidth As Integer = 0, _
Optional ByVal bVaryByCategories As Boolean = False, _
Optional ByVal iChartDepth As Integer = 150, _
Optional ByVal iGapDepth As Integer = 100)
Dim objChartGroup As Excel.ChartGroup
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objSeries
'.Border.Color = iBorderColour
.Border.ColorIndex = iBorderColourIdx
.Border.Weight = ChartReturns_BorderWeight(iBorderWeight)
.Border.LineStyle = ChartReturns_LineStyle(sBorderLineStyle)
.Shadow = bShadow
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.Overlap = iOverlapWidth
.GapWidth = iGapWidth
.HasSeriesLines = bHasSeriesLine
.VaryByCategories = bVaryByCategories
End With
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatColumn", msMODULENAME, _
"apply the customised 'Column' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatCone
Public Sub ChartSeries_FormatCone(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatCone", msMODULENAME, _
"apply the customised 'Cone' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatCylinder
Public Sub ChartSeries_FormatCylinder(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatCylinder", msMODULENAME, _
"apply the customised 'Cylinder' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatDoughnut
Public Sub ChartSeries_FormatDoughnut(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Dim objChartArea As Excel.ChartArea
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngchartwidth As Single
Dim sngchartheight As Single
Dim ssmallestside As String
Dim ismallestlength As Integer
Dim idivisionlength As Integer
objChartArea = objChart.ChartArea
'----------------- sizing the pie chart to the correct size and centering
With objChart
If objChartArea.Width <= objChartArea.Height Then
ismallestlength = CInt(objChartArea.Width)
ssmallestside = "W"
End If
If objChartArea.Height < objChartArea.Width Then
ismallestlength = CInt(objChartArea.Height)
ssmallestside = "H"
End If
idivisionlength = CInt(ismallestlength / 6)
.PlotArea.Width = idivisionlength * 4
If ssmallestside = "H" Then
.PlotArea.Top = idivisionlength
.PlotArea.Left = (.ChartArea.Width - .ChartArea.Height) / 2
.PlotArea.Left = .PlotArea.Left + idivisionlength
End If
If ssmallestside = "W" Then
.PlotArea.Left = idivisionlength
.PlotArea.Top = (.ChartArea.Height - .ChartArea.Width) / 2
.PlotArea.Top = .PlotArea.Top + idivisionlength
End If
End With
'----------------------------
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartArea = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatDoughnut", msMODULENAME, _
"apply the customised 'Doughnut' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatLine
Public Sub ChartSeries_FormatLine(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 3, _
Optional ByVal sBorderLineStyle As String = "CT", _
Optional ByVal bSmooth As Boolean = False, _
Optional ByVal iMarkerForeColour As Integer = 0, _
Optional ByVal iMarkerBackColour As Integer = 0, _
Optional ByVal sMarkerStyleKey As String = "NO", _
Optional ByVal iMarkerSize As Integer = 3, _
Optional ByVal bMarkerShadow As Boolean = False, _
Optional ByVal bDropLines As Boolean = False, _
Optional ByVal bHiLoLines As Boolean = False, _
Optional ByVal bUpDownBars As Boolean = False, _
Optional ByVal iGapWidth As Integer = 0, _
Optional ByVal bVaryByCategories As Boolean = False)
Dim objChartGroup1 As Excel.ChartGroup
Dim objChartGroup2 As Excel.ChartGroup
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objSeries
If iBorderColour = 0 Then _
.Border.ColorIndex = Colour_LineReturn(iSeriesNo)
'25 is the start of the line styles
If iBorderColour > 0 Then .Border.Color = iBorderColour
.Border.LineStyle = ChartReturns_LineStyle(sBorderLineStyle)
.Border.Weight = ChartReturns_BorderWeight(iBorderWeight)
.Smooth = bSmooth
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
If sMarkerStyleKey <> "NO" Then
.MarkerForegroundColorIndex = CType(iMarkerForeColour, Excel.XlColorIndex)
.MarkerBackgroundColorIndex = CType(iMarkerBackColour, Excel.XlColorIndex)
'have to have the style last
.MarkerStyle = ChartReturns_MarkerStyle(sMarkerStyleKey)
.MarkerSize = iMarkerSize
.Shadow = bMarkerShadow
End If
'the groups are relative to which axes the series is on
If ChartSeries_AxisUsed(objSeries) = "P" Then
objChartGroup1 = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup1
.HasDropLines = bDropLines
.HasHiLoLines = bHiLoLines
.HasUpDownBars = bUpDownBars
.VaryByCategories = bVaryByCategories
End With
End If
If ChartSeries_AxisUsed(objSeries) = "S" Then
objChartGroup2 = CType(objChart.ChartGroups(2), Excel.ChartGroup)
With objChartGroup2
.HasDropLines = bDropLines
.HasHiLoLines = bHiLoLines
.HasUpDownBars = bUpDownBars
.VaryByCategories = bVaryByCategories
End With
End If
If ChartType_SeriesTypeIsIt3D(objSeries) = True Then
Call ChartSeries_Format3D(objChart, objSeries, iSeriesNo)
End If
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup1 = Nothing
objChartGroup2 = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatLine", msMODULENAME, _
"apply the customised 'Line' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatPie
Public Sub ChartSeries_FormatPie(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iBorderColour As Integer = 0, _
Optional ByVal iBorderWeight As Integer = 1, _
Optional ByVal sBorderLineStyle As String = "NO", _
Optional ByVal iFirstAngleSlice As Integer = 0, _
Optional ByVal iExplosion As Integer = 0, _
Optional ByVal bVaryByCategories As Boolean = True)
Dim objChartGroup As Excel.ChartGroup
Dim objChartArea As Excel.ChartArea
Dim objPointsCol As Excel.Points
Dim objPoint As Excel.Point
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngchartwidth As Single
Dim sngchartheight As Single
Dim icount As Integer
Dim ipointcount As Integer
Dim ssmallestside As String
Dim ismallestlength As Integer
Dim idivisionlength As Integer
objChartArea = objChart.ChartArea
With objSeries
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.VaryByCategories = bVaryByCategories
.FirstSliceAngle = iFirstAngleSlice
End With
.Explosion = iExplosion
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowPercent)
.HasLeaderLines = False
'.Has3DEffect = False
'.HasErrorBars = false
'.HasDataLabels = True
objPointsCol = CType(objSeries.Points, Excel.Points)
For ipointcount = 1 To objPointsCol.Count
objPoint = CType(.Points(ipointcount), Excel.Point)
With objPoint
.Border.Color = iBorderColour
.Border.Weight = ChartReturns_BorderWeight(iBorderWeight)
.Border.LineStyle = ChartReturns_LineStyle(sBorderLineStyle)
.Interior.Pattern = Excel.XlPattern.xlPatternSolid 'xlSolid
.Interior.ColorIndex = Colour_AreaReturn(ipointcount)
End With
Next ipointcount
' .AxisGroup = 1 'this should apply to all pie charts I think
End With
'----------------- sizing the pie chart to the correct size and centering
With objChart
If objChartArea.Width <= objChartArea.Height Then
ismallestlength = CInt(objChartArea.Width)
ssmallestside = "W"
End If
If objChartArea.Height < objChartArea.Width Then
ismallestlength = CInt(objChartArea.Height)
ssmallestside = "H"
End If
'subtract the size of the legend so the pie chart is perfectly in the middle
If (objChart.HasLegend = False) Then
idivisionlength = CInt(ismallestlength / 6)
.PlotArea.Width = idivisionlength * 4
If ssmallestside = "H" Then
.PlotArea.Top = idivisionlength
.PlotArea.Left = (.ChartArea.Width - .ChartArea.Height) / 2
.PlotArea.Left = .PlotArea.Left + idivisionlength
End If
If ssmallestside = "W" Then
.PlotArea.Left = idivisionlength
.PlotArea.Top = (.ChartArea.Height - .ChartArea.Width) / 2
.PlotArea.Top = .PlotArea.Top + idivisionlength
End If
Else
If App_RegTypesPieAutomaticLegendPositionRead() = True Then
If ssmallestside = "H" Then
'put the legend on the right (have option to put on left)
Call ChartFormat_LegendSizePosition(objChart, "RI")
End If
If ssmallestside = "W" Then
'put the legend underneath
Call ChartFormat_LegendSizePosition(objChart, "BT")
End If
End If
idivisionlength = CInt(ismallestlength / 6)
.PlotArea.Width = idivisionlength * 4
If ssmallestside = "H" Then
.PlotArea.Top = idivisionlength
.PlotArea.Left = (.ChartArea.Width - .ChartArea.Height) / 2
.PlotArea.Left = .PlotArea.Left + idivisionlength
'if we are moving the position of the plot area
If True Then
'legend is on the right so move plot area to the left
.PlotArea.Left = .PlotArea.Left - (.Legend.Width / 2)
End If
End If
If ssmallestside = "W" Then
.PlotArea.Left = idivisionlength
.PlotArea.Top = (.ChartArea.Height - .ChartArea.Width) / 2
.PlotArea.Top = .PlotArea.Top + idivisionlength
'if we are moving the position of the plot area
If True Then
'legend is below so move the plot area up
.PlotArea.Top = .PlotArea.Top - (.Legend.Height / 2)
End If
End If
End If
End With
'----------------------------
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
objChartArea = Nothing
objPointsCol = Nothing
objPoint = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatPie", msMODULENAME, _
"apply the customised 'Pie' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatPyramid
Public Sub ChartSeries_FormatPyramid(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatPyramid", msMODULENAME, _
"apply the customised 'Pyramid' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatRadar
Public Sub ChartSeries_FormatRadar(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Dim objChartArea As Excel.ChartArea
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim sngchartwidth As Single
Dim sngchartheight As Single
Dim ssmallestside As String
Dim ismallestlength As Integer
Dim idivisionlength As Integer
' If sMarkerStyleKey <> "NO" Then
' .MarkerForegroundColorIndex = iMarkerForeColour
' .MarkerBackgroundColorIndex = iMarkerBackColour
' have to have the style last
' .MarkerStyle = Return_MarkerStyle(sMarkerStyleKey)
' .MarkerSize = iMarkerSize
' .Shadow = bMarkerShadow
' End If
objChartArea = objChart.ChartArea
'----------------- sizing the pie chart to the correct size and centering
With objChart
If objChartArea.Width <= objChartArea.Height Then
ismallestlength = CInt(objChartArea.Width)
ssmallestside = "W"
End If
If objChartArea.Height < objChartArea.Width Then
ismallestlength = CInt(objChartArea.Height)
ssmallestside = "H"
End If
idivisionlength = CInt(ismallestlength / 6)
.PlotArea.Width = idivisionlength * 4
If ssmallestside = "H" Then
.PlotArea.Top = idivisionlength
.PlotArea.Left = (.ChartArea.Width - .ChartArea.Height) / 2
.PlotArea.Left = .PlotArea.Left + idivisionlength
End If
If ssmallestside = "W" Then
.PlotArea.Left = idivisionlength
.PlotArea.Top = (.ChartArea.Height - .ChartArea.Width) / 2
.PlotArea.Top = .PlotArea.Top + idivisionlength
End If
End With
'----------------------------
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatRadar", msMODULENAME, _
"apply the customised 'Radar' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatScatter
Public Sub ChartSeries_FormatScatter(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
'remove the line
' If sChartType = "S" Then
' If iInteriorColourIdx = 0 Then .Interior.ColorIndex = 16 + iSeriesNo
' If iInteriorColourIdx > 0 Then .Interior.ColorIndex = 16 + iInteriorColourIdx
' .MarkerStyle
' .MarkerBackgroundColorIndex
' .MarkerForegroundColorIndex
' .MarkerSize
' .Shadow
' End If
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatScatter", msMODULENAME, _
"apply the customised 'Scatter' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
'****************************************************************************************
ChartSeries_FormatStacked
Public Sub ChartSeries_FormatStacked(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iGapWidth As Integer = 100, _
Optional ByVal bHasSeriesLine As Boolean = False, _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iOverlapWidth As Integer = 100, _
Optional ByVal bVaryByCategories As Boolean = False, _
Optional ByVal iChartDepth As Integer = 150, _
Optional ByVal iGapDepth As Integer = 100)
Dim objChartGroup As Excel.ChartGroup
Dim objAxis As Excel.Axis
Dim objTickLabels As Excel.TickLabels
Try
If clsError.ErrorFlag() = True Then Exit Sub
With objSeries
.Shadow = bShadow
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.Overlap = iOverlapWidth
.GapWidth = iGapWidth
.HasSeriesLines = bHasSeriesLine
.VaryByCategories = bVaryByCategories
End With
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlPrimary), Excel.Axis)
If ChartType_SeriesTypeIsItStacked100(objSeries) = True Then
objTickLabels = CType(objAxis.TickLabels, Excel.TickLabels)
objTickLabels.NumberFormat = "0%"
End If
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
objAxis = Nothing
objTickLabels = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatStacked", msMODULENAME, _
"apply the customised 'Stacked' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatStacked100
Public Sub ChartSeries_FormatStacked100(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer, _
Optional ByVal iGapWidth As Integer = 100, _
Optional ByVal bHasSeriesLine As Boolean = False, _
Optional ByVal bShadow As Boolean = False, _
Optional ByVal iOverlapWidth As Integer = 100, _
Optional ByVal bVaryByCategories As Boolean = False, _
Optional ByVal iChartDepth As Integer = 150, _
Optional ByVal iGapDepth As Integer = 100)
Dim objChartGroup As Excel.ChartGroup
Dim objAxis As Excel.Axis
Dim objTickLabels As Excel.TickLabels
Try
If clsError.ErrorFlag() = True Then Exit Sub
Dim bvertically As Boolean
Dim bhorizontally As Boolean
bvertically = ChartType_SeriesTypeIsItStacked100Vertical(objSeries)
bhorizontally = ChartType_SeriesTypeIsItStacked100Horizontal(objSeries)
With objSeries
.Shadow = bShadow
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
objChartGroup = CType(objChart.ChartGroups(1), Excel.ChartGroup)
With objChartGroup
.Overlap = iOverlapWidth
.GapWidth = iGapWidth
.HasSeriesLines = bHasSeriesLine
.VaryByCategories = bVaryByCategories
End With
objAxis = CType(objChart.Axes(Excel.XlAxisType.xlValue, _
Excel.XlAxisGroup.xlPrimary), Excel.Axis)
objTickLabels = CType(objAxis.TickLabels, Excel.TickLabels)
objTickLabels.NumberFormat = "0%"
End With
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
objChartGroup = Nothing
objAxis = Nothing
objTickLabels = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatStacked100", msMODULENAME, _
"apply the customised 'Stacked 100' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatStock
Public Sub ChartSeries_FormatStock(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatStock", msMODULENAME, _
"apply the customised 'Stock' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormatSurface
Public Sub ChartSeries_FormatSurface(ByVal objChart As Excel.Chart, _
ByVal objSeries As Excel.Series, _
ByVal iSeriesNo As Integer)
Try
If clsError.ErrorFlag() = True Then Exit Sub
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormatSurface", msMODULENAME, _
"apply the customised 'Surface' formatting to the active chart.", _
mobjCOMException, mobjException)
End If
End Try
End Sub
ChartSeries_FormulaXValuesGet
Public Function ChartSeries_FormulaXValuesGet(ByVal objSeries As Excel.Series) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sFormula As String
Dim icharpos As Integer
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 = clsStr.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, ",")
If Left(sFormula, 1) = "'" Then
icharpos = clsStr.FindPositionOfOddSeq(sFormula, "!", "'", 3)
End If
ChartSeries_FormulaXValuesGet = Left(sFormula, InStr(icharpos, sFormula, ",") - 1)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormulaLabelsGet", msMODULENAME, _
"return the series 'LABELS' component for series " & objSeries.Name & _
" for the active chart", _
gobjCOMException, gobjException)
End If
End Try
End Function
'***************************************************************************************
ChartSeries_FormulaYValuesGet
Public Function ChartSeries_FormulaValuesGet(ByVal objSeries As Excel.Series) As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim sFormula As String
Dim icharpos As Integer
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 = clsStr.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 = clsStr.FindPositionOfOddSeq(sFormula, "!", "'", 3)
sFormula = Right(sFormula, Len(sFormula) - icharpos)
sFormula = Right(sFormula, Len(sFormula) - InStr(sFormula, ","))
End If
ChartSeries_FormulaValuesGet = Left(sFormula, InStr(1, sFormula, ",") - 1)
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartSeries_FormulaValuesGet", msMODULENAME, _
"return the series 'VALUES' component for series " & objSeries.Name & _
" for the active chart", _
gobjCOMException, gobjException)
End If
End Try
End Function
'****************************************************************************************
ChartSeries_Type_Change
Public Sub ChartSeries_Type_Change(ByVal objSeries As Excel.Series, _
ByVal iChartType As Excel.XlChartType)
Try
If clsError.ErrorFlag() = True Then Exit Sub
objSeries.ChartType = CType(iChartType, Excel.XlChartType)
objSeries.Select()
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("Chart_SeriesTypeChange", msMODULENAME, _
"change the type of the active chart series.", _
gobjCOMException, gobjException)
End If
End Try
End Sub
ChartSeries_Type_Convert
Public Function ChartSeries_Type_Convert(ByVal iSeriesNo As Integer) _
As Long
Dim objChart As Excel.Chart
Dim objSeries As Excel.Series
Try
If clsError.ErrorFlag() = True Then Exit Function
Dim itype As Integer
objChart = gApplication.ActiveChart
objSeries = CType(objChart.SeriesCollection(iSeriesNo), Excel.Series)
Select Case objSeries.ChartType.ToString & _
Space(26 - objSeries.ChartType.ToString.Length)
Case "xlColumnClustered " : itype = xlColumnClustered
Case "xlColumnStacked " : itype = xlColumnStacked
Case "xlColumnStacked100 " : itype = xlColumnStacked100
Case "xl3DColumnClustered " : itype = xlColumnClustered
Case "xl3DColumnStacked " : itype = xlColumnStacked
Case "xl3DColumnStacked100 " : itype = xlColumnStacked100
Case "xl3DColumn " : itype = xlColumnClustered
'---------------------------------------------
Case "xlBarClustered " : itype = xlBarClustered
Case "xlBarStacked " : itype = xlBarStacked
Case "xlBarStacked100 " : itype = xlBarStacked100
Case "xl3DBarClustered " : itype = xlBarClustered
Case "xl3DBarStacked " : itype = xlBarStacked
Case "xl3DBarStacked100 " : itype = xlBarStacked100
'---------------------------------------------
Case "xlLine " : itype = xlLine
Case "xlLineStacked " : itype = xlLine
Case "xlLineStacked100 " : itype = xlLine
Case "xlLineMarkers " : itype = xlLine
Case "xlLineMarkersStacked " : itype = xlLine
Case "xlLineMarkersStacked100 " : itype = xlLine
Case "xl3DLine " : itype = xlLine
'---------------------------------------------
Case "xlPie " : itype = xlPie
Case "xlPieExploded " : itype = xlPie
Case "xlPieOfPie " : itype = xlPie
Case "xl3DPie " : itype = xlPie
Case "xl3DPieExploded " : itype = xlPie
Case "xlBarOfPie " : itype = xlPie
'---------------------------------------------
Case "xlXYScatter " : itype = xlXYScatter
Case "xlXYScatterLines " : itype = xlXYScatter
Case "xlXYScatterLinesNoMarkers " : itype = xlXYScatter
Case "xlXYScatterSmooth " : itype = xlXYScatter
Case "xlXYScatterSmoothNoMarkers" : itype = xlXYScatter
'---------------------------------------------
Case "xlArea " : itype = xlArea
Case "xlAreaStacked " : itype = xlAreaStacked
Case "xlAreaStacked100 " : itype = xlAreaStacked100
Case "xl3DArea " : itype = xlArea
Case "xl3DAreaStacked " : itype = xlAreaStacked
Case "xl3DAreaStacked100 " : itype = xlAreaStacked100
'---------------------------------------------
Case "xlDoughnut " : itype = xlPie
Case "xlDoughnutExploded " : itype = xlPie
'---------------------------------------------
Case "xlRadar " : itype = xlRadar
Case "xlRadarMarkers " : itype = xlRadarMarkers
Case "xlRadarFilled " : itype = xlRadarFilled
'---------------------------------------------
Case "xlSurface " : itype = xlArea
Case "xlSurfaceWireframe " : itype = xlArea
Case "xlSurfaceTopView " : itype = xlArea
Case "xlSurfaceTopViewWireframe " : itype = xlArea
'---------------------------------------------
Case "xlBubble " : itype = xlColumnClustered
Case "xlBubble3DEffect " : itype = xlColumnClustered
'---------------------------------------------
Case "xlStockHLC " : itype = xlStockHLC
Case "xlStockVHLC " : itype = xlStockVHLC
Case "xlStockOHLC " : itype = xlStockOHLC
Case "xlStockVOHLC " : itype = xlStockVOHLC
'---------------------------------------------
Case "xlCylinderCol " : itype = xlColumnClustered
Case "xlCylinderBarClustered " : itype = xlBarClustered
Case "xlCylinderBarStacked " : itype = xlBarStacked
Case "xlCylinderBarStacked100 " : itype = xlBarStacked100
Case "xlCylinderColClustered " : itype = xlColumnClustered
Case "xlCylinderColStacked " : itype = xlColumnStacked
Case "xlCylinderColStacked100 " : itype = xlColumnStacked100
'---------------------------------------------
Case "xlConeBarClustered " : itype = xlBarClustered
Case "xlConeBarStacked " : itype = xlBarStacked
Case "xlConeBarStacked100 " : itype = xlBarStacked100
Case "xlConeCol " : itype = xlBarStacked
Case "xlConeColClustered " : itype = xlColumnClustered
Case "xlConeColStacked " : itype = xlColumnStacked
Case "xlConeColStacked100 " : itype = xlColumnStacked100
'---------------------------------------------
Case "xlPyramidBarClustered " : itype = xlBarClustered
Case "xlPyramidBarStacked " : itype = xlBarStacked
Case "xlPyramidBarStacked100 " : itype = xlBarStacked100
Case "xlPyramidCol " : itype = xlColumnClustered
Case "xlPyramidColClustered " : itype = xlColumnClustered
Case "xlPyramidColStacked " : itype = xlBarStacked
Case "xlPyramidColStacked100 " : itype = xlColumnStacked100
'---------------------------------------------
'Case xlbar : itype = xlColumnClustered
'Case xl3DBar: itype = xlBarClustered
'Case xl3D bar doesn't seem to exist
Case Else
Call MsgBox( _
"The chart type for the series " & iSeriesNo & _
" on the active chart is " & _
objSeries.ChartType.ToString & vbCrLf & _
"This chart type is not included on the list as yet!", , _
"ChartType_SeriesTypeConvert")
End Select
ChartType_SeriesTypeConvert = itype
'Call MsgBox("Chart type has been changed from " & _
' objSeries.ChartType.ToString & " to " & itype)
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objChart = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeConvert", msMODULENAME, _
"convert the chart type for series " & iSeriesNo & vbCrLf & _
"The current chart type is: " & objSeries.ChartType.ToString & ".", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsIt3D
Public Function ChartSeries_Type_IsIt3D(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xl3DArea, _
xl3DAreaStacked, _
xl3DAreaStacked100, _
xl3DBarClustered, _
xl3DBarStacked, _
xl3DBarStacked100, _
xl3DColumn, _
xl3DColumnClustered, _
xl3DColumnStacked, _
xl3DColumnStacked100, _
xl3DLine, _
xl3DPie, _
xl3DPieExploded, _
xlCylinderCol, _
xlCylinderBarClustered, _
xlCylinderBarStacked, _
xlCylinderBarStacked100, _
xlCylinderColClustered, _
xlCylinderColStacked, _
xlCylinderColStacked100, _
xlConeBarClustered, _
xlConeBarStacked, _
xlConeBarStacked100, _
xlConeCol, _
xlConeColClustered, _
xlConeColStacked, _
xlConeColStacked100, _
xlPyramidBarClustered, _
xlPyramidBarStacked, _
xlPyramidBarStacked100, _
xlPyramidCol, _
xlPyramidColClustered, _
xlPyramidColStacked, _
xlPyramidColStacked100
ChartType_SeriesTypeIsIt3D = True
Case Else
ChartType_SeriesTypeIsIt3D = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeIsIt3D", msMODULENAME, _
"determine if this series on the active chart" & _
" is a '3D' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItBubble
Public Function ChartSeries_Type_IsItBubble(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlBubble, _
xlBubble3DEffect
ChartType_SeriesTypeIsItBubble = True
Case Else
ChartType_SeriesTypeIsItBubble = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeIsItBubble", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Bubble' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItDoughnut
Public Function ChartSeries_Type_IsItDoughnut(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlDoughnut, _
xlDoughnutExploded
ChartType_SeriesTypeIsItDoughnut = True
Case Else
ChartType_SeriesTypeIsItDoughnut = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeIsItDoughnut", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Doughnut' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItPie
Public Function ChartSeries_Type_IsItPie(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlPie, _
xlPieOfPie, _
xlBarOfPie, _
xlPieExploded, _
xl3DPie, _
xl3DPieExploded
ChartType_SeriesTypeIsItPie = True
Case Else
ChartType_SeriesTypeIsItPie = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("Chart_SeriesTypeIsItPie", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Pie' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItStacked
Public Function ChartSeries_Type_IsItStacked(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlAreaStacked, _
xl3DAreaStacked, _
xlBarStacked, _
xl3DBarStacked, _
xlColumnStacked, _
xl3DColumnStacked, _
xlConeBarStacked, _
xlConeColStacked, _
xlCylinderBarStacked, _
xlCylinderColStacked, _
xlLineMarkersStacked, _
xlLineStacked, _
xlPyramidBarStacked, _
xlPyramidColStacked
ChartType_SeriesTypeIsItStacked = True
Case Else
ChartType_SeriesTypeIsItStacked = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("Chart_SeriesTypeIsItStacked", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Stacked' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItStacked100
Public Function ChartSeries_Type_IsItStacked100(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
If ChartType_SeriesTypeIsItStacked100Horizontal(objSeries) Or _
ChartType_SeriesTypeIsItStacked100Vertical(objSeries) Then
ChartType_SeriesTypeIsItStacked100 = True
Else
ChartType_SeriesTypeIsItStacked100 = False
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeIsItStacked100", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Stacked 100' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItStacked100Horizontal
Public Function ChartSeries_Type_IsItStacked100Horizontal(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlBarStacked100, _
xl3DBarStacked100, _
xlConeBarStacked100, _
xlCylinderBarStacked100, _
xlPyramidBarStacked100
ChartType_SeriesTypeIsItStacked100Horizontal = True
Case Else
ChartType_SeriesTypeIsItStacked100Horizontal = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("Chart_SeriesTypeIsItStacked100Horizontal", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Horizontally Stacked' chart type.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItStacked100Vertical
Public Function ChartSeries_Type_IsItStacked100Vertical(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlAreaStacked100, _
xl3DAreaStacked100, _
xlColumnStacked100, _
xl3DColumnStacked100, _
xlConeColStacked100, _
xlCylinderColStacked100, _
xlLineMarkersStacked100, _
xlPyramidColStacked100
ChartType_SeriesTypeIsItStacked100Vertical = True
Case Else
ChartType_SeriesTypeIsItStacked100Vertical = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("Chart_SeriesTypeIsItStacked100Vertical", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Vertically Stacked' chart type", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_IsItSurface
Public Function ChartSeries_Type_IsItSurface(ByVal objSeries As Excel.Series) _
As Boolean
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlSurface, _
xlSurfaceWireframe, _
xlSurfaceTopView
ChartType_SeriesTypeIsItSurface = True
'xlsurfacetopviewwireframe: 'doesn't seem to recognise ??????
Case Else
ChartType_SeriesTypeIsItSurface = False
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_SeriesTypeIsItSurface", msMODULENAME, _
"determine if this series on the active chart" & _
" is a 'Surface' chart type", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_NameToEnumeration
Public Function ChartSeries_Type_NameToEnumeration(ByVal sChartTypeName As String) _
As Excel.XlChartType
Dim lreturn As Excel.XlChartType
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case sChartTypeName & Space(30 - sChartTypeName.Length)
Case "Area " : lreturn = xlArea
Case "Area - Stacked " : lreturn = xlAreaStacked
Case "Area - Stacked 100 " : lreturn = xlAreaStacked100
Case "Area - 3D " : lreturn = xl3DArea
Case "Area - 3D Stacked " : lreturn = xl3DAreaStacked
Case "Area - 3D Stacked 100 " : lreturn = xl3DAreaStacked100
Case "Bar - Clustered " : lreturn = xlBarClustered
Case "Bar - Clustered Cone " : lreturn = xlConeBarClustered
Case "Bar - Clustered Cylinder " : lreturn = xlCylinderBarClustered
Case "Bar - Clustered Pyramid " : lreturn = xlPyramidBarClustered
Case "Bar - Stacked " : lreturn = xlBarStacked
Case "Bar - Stacked Cone " : lreturn = xlConeBarStacked
Case "Bar - Stacked Cylinder " : lreturn = xlCylinderBarStacked
Case "Bar - Stacked Pyramid " : lreturn = xlPyramidBarStacked
Case "Bar - Stacked 100 " : lreturn = xlBarStacked100
Case "Bar - Stacked Cone 100 " : lreturn = xlConeBarStacked100
Case "Bar - Stacked Cylinder 100 " : lreturn = xlCylinderBarStacked100
Case "Bar - Stacked Pyramid 100 " : lreturn = xlPyramidBarStacked100
Case "Bar - 3D Clustered " : lreturn = xl3DBarClustered
Case "Bar - 3D Stacked " : lreturn = xl3DBarStacked
Case "Bar - 3D Stacked 100 " : lreturn = xl3DBarStacked100
Case "Bubble " : lreturn = xlBubble
Case "Bubble - 3D " : lreturn = xlBubble3DEffect
Case "Column - Clustered " : lreturn = xlColumnClustered
Case "Column - Clustered Cone " : lreturn = xlConeColClustered
Case "Column - Clustered Cylinder " : lreturn = xlCylinderColClustered
Case "Column - Clustered Pyramid " : lreturn = xlPyramidColClustered
Case "Column - Stacked " : lreturn = xlColumnStacked
Case "Column - Stacked Cone " : lreturn = xlConeColStacked
Case "Column - Stacked Cylinder " : lreturn = xlCylinderColStacked
Case "Column - Stacked Pyramid " : lreturn = xlPyramidColStacked
Case "Column - Stacked 100 " : lreturn = xlColumnStacked100
Case "Column - Stacked Cone 100 " : lreturn = xlConeColStacked100
Case "Column - Stacked Cylinder 100 " : lreturn = xlCylinderColStacked100
Case "Column - Stacked Pyramid 100 " : lreturn = xlPyramidColStacked100
Case "Column - 3D " : lreturn = xl3DColumn
Case "Column - 3D Clustered " : lreturn = xl3DColumnClustered
Case "Column - 3D Stacked " : lreturn = xl3DColumnStacked
Case "Column - 3D Stacked 100 " : lreturn = xl3DColumnStacked100
Case "Doughnut " : lreturn = xlDoughnut
Case "Doughnut - Exploded " : lreturn = xlDoughnutExploded
Case "Line " : lreturn = xlLine
Case "Line - Stacked " : lreturn = xlLineStacked
Case "Line - Stacked 100 " : lreturn = xlLineStacked100
Case "Line - Markers " : lreturn = xlLineMarkers
Case "Line - Markers Stacked " : lreturn = xlLineMarkersStacked
Case "Line - Markers Stacked 100 " : lreturn = xlLineMarkersStacked100
Case "Line - 3D " : lreturn = xl3DLine
Case "Pie " : lreturn = xlPie
Case "Pie - Exploded " : lreturn = xlPieExploded
Case "Pie - Of Pie " : lreturn = xlPieOfPie
Case "Pie - 3D " : lreturn = xl3DPie
Case "Pie - 3D Exploded " : lreturn = xl3DPieExploded
Case "Radar " : lreturn = xlRadar
Case "Radar - Markers " : lreturn = xlRadarMarkers
Case "Radar - Filled " : lreturn = xlRadarFilled
Case "Stock - High Low Close " : lreturn = xlStockHLC
Case "Stock - V High Low Close " : lreturn = xlStockVHLC
Case "Stock - O High Low Close " : lreturn = xlStockOHLC
Case "Stock - V O High Low Close " : lreturn = xlStockVOHLC
Case "Scatter XY " : lreturn = xlXYScatter
Case "Scatter XY - Lines " : lreturn = xlXYScatterLines
Case "Scatter XY - Lines No Markers " : lreturn = xlXYScatterLinesNoMarkers
Case "Scatter XY - Smooth " : lreturn = xlXYScatterSmooth
Case "Scatter XY - Smooth No Markers" : lreturn = xlXYScatterSmoothNoMarkers
Case "Surface " : lreturn = xlSurface
Case "Surface - WireFrame " : lreturn = xlSurfaceWireframe
Case "Surface (TopView) " : lreturn = xlSurfaceTopView
Case "Surface - WireFrame (Top view)" : lreturn = xlSurfaceTopViewWireframe
Case Else
Call MsgBox("Incorrect Chart Type name : " & sChartTypeName, , _
"ChartType_NameReturnType")
End Select
'Surface Top View ???
ChartType_ReturnChartType = lreturn
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
lreturn = Nothing
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("ChartType_ReturnChartType", msMODULENAME, _
"return the corresponding chart type for '" & sChartTypeName & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Type_ReturnCategory
Public Function ChartSeries_Type_ReturnCategory(ByVal objSeries As Excel.Series) _
As String
Try
If clsError.ErrorFlag() = True Then Exit Function
Select Case objSeries.ChartType
Case xlColumnClustered, _
xlColumnStacked, _
xlColumnStacked100, _
xl3DColumn, _
xl3DColumnClustered, _
xl3DColumnStacked, _
xl3DColumnStacked100 : ChartType_ReturnCategory = "Column"
Case xlBarClustered, _
xlBarStacked, _
xlBarStacked100, _
xl3DBarClustered, _
xl3DBarStacked, _
xl3DBarStacked100 : ChartType_ReturnCategory = "Bar"
Case xlLine, _
xlLineStacked, _
xlLineStacked100, _
xlLineMarkers, _
xlLineMarkersStacked, _
xlLineMarkersStacked100, _
xl3DLine : ChartType_ReturnCategory = "Line"
Case xlBarOfPie, _
xlPie, _
xlPieExploded, _
xlPieOfPie, _
xl3DPie, _
xl3DPieExploded : ChartType_ReturnCategory = "Pie"
Case xlXYScatter, _
xlXYScatterLines, _
xlXYScatterLinesNoMarkers, _
xlXYScatterSmooth, _
xlXYScatterSmoothNoMarkers : ChartType_ReturnCategory = "Scatter"
Case xlArea, _
xlAreaStacked, _
xlAreaStacked100, _
xl3DArea, _
xl3DAreaStacked, _
xl3DAreaStacked100 : ChartType_ReturnCategory = "Area"
Case xlDoughnut, _
xlDoughnutExploded : ChartType_ReturnCategory = "Doughnut"
Case xlRadar, _
xlRadarMarkers, _
xlRadarFilled : ChartType_ReturnCategory = "Radar"
Case xlSurface, _
xlSurfaceTopView, _
xlSurfaceTopViewWireframe, _
xlSurfaceWireframe : ChartType_ReturnCategory = "Surface"
Case xlBubble, _
xlBubble3DEffect : ChartType_ReturnCategory = "Bubble"
Case xlStockHLC, _
xlStockVHLC, _
xlStockOHLC, _
xlStockVOHLC : ChartType_ReturnCategory = "Stock"
Case xlCylinderBarClustered, _
xlCylinderBarStacked, _
xlCylinderBarStacked100, _
xlCylinderColClustered, _
xlCylinderColStacked, _
xlCylinderColStacked100 : ChartType_ReturnCategory = "Cylinder"
Case xlConeBarClustered, _
xlConeBarStacked, _
xlConeBarStacked100, _
xlConeColClustered, _
xlConeColStacked, _
xlConeColStacked100 : ChartType_ReturnCategory = "Cone"
Case xlPyramidCol, _
xlPyramidBarClustered, _
xlPyramidBarStacked, _
xlPyramidBarStacked100, _
xlPyramidColClustered, _
xlPyramidColStacked, _
xlPyramidColStacked100 : ChartType_ReturnCategory = "Pyramid"
Case Else
Call MsgBox("Incorrect Chart Type number : " & _
objSeries.ChartType.ToString, , _
"Chart_TypeReturn")
End Select
Catch objCOMException As System.Runtime.InteropServices.COMException
mobjCOMException = objCOMException
Catch objException As Exception
mobjException = objException
Finally
If gbDEBUG = True Or _
((IsNothing(mobjCOMException) = False Or IsNothing(mobjException) = False)) Then
Call clsError.Handle("Chart_TypeReturn", msMODULENAME, _
"return the category name for the series '" & objSeries.Name & "'.", _
mobjCOMException, mobjException)
End If
End Try
End Function
ChartSeries_Valid
Public Shared Function ChartSeriesValid(ByVal objSeriesColl As Excel.SeriesCollection, _
ByVal iSeriesNo As Integer) As Boolean
Try
'an error occurs when the series number is valid but not plotted - eg Pie Charts
Dim objSeries As Excel.Series
objSeries = objSeriesColl.Item(iSeriesNo)
ChartSeriesValid = True
Catch objCOMException As System.Runtime.InteropServices.COMException
ChartSeriesValid = False
End Try
End Function
ChartSource_DataPlotByGet
Public Function ChartSource_DataPlotByGet(ByVal objChart As Excel.Chart) As String
Dim objSeriesCol As Excel.SeriesCollection
Dim objSeries As Excel.Series
Try
If clsError.ErrorFlag() = True Then Exit Function
objSeriesCol = CType(objChart.SeriesCollection, Excel.SeriesCollection)
If objSeriesCol.Count > 0 Then
objSeries = objSeriesCol.Item(1)
Call MsgBox("Series Values: " & ChartSeries_FormulaValuesGet(objSeries) & _
vbCrLf & _
"Series Labels: " & ChartSeries_FormulaLabelsGet(objSeries))
'Call MsgBox("Formula " & objSeries.Formula & vbCrLf & _
' "Formula Local " & objSeries.FormulaLocal & vbCrLf & _
' "Formula R1C1 " & objSeries.FormulaR1C1 & vbCrLf & _
' "Formula R1C1 Local " & objSeries.FormulaR1C1Local)
End If
Catch objCOMException As System.Runtime.InteropServices.COMException
gobjCOMException = objCOMException
Catch objException As Exception
gobjException = objException
Finally
objChart = Nothing
objSeriesCol = Nothing
objSeries = Nothing
If gbDEBUG = True Or _
((IsNothing(gobjCOMException) = False Or IsNothing(gobjException) = False)) Then
Call clsError.Handle("ChartSeries_SourceDataPlotByGet", msMODULENAME, _
"", _
gobjCOMException, gobjException)
End If
End Try
End Function
Message_NoChartIsSelected
Public Shared Sub ChartNoChartSelectedInformation()
Call System.Windows.Forms.MessageBox.Show( _
"No chart is currently selected.", _
gsDIALOG_PREFIX_EXCEL, _
Windows.Forms.MessageBoxButtons.OK, _
Windows.Forms.MessageBoxIcon.Information)
End Sub
'***************************************************************************************
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top