Cannot get my chart ‘stacked’ using a Calc macro - libreoffice
Somehow I cannot get my chart to ‘stack’. For reasons explained below I first prepare a standard chart in a macro called ‘ChartsGeneral’. Based on some settings on my ‘Charts’ worksheet, it then calls a specific second macro, e.g. ‘ChartBuildStatus’. In this second macro I generate the category and data-series, and adjust the settings of the standard chart as necessary.
When I try to get a stacked chart via ‘createInstance(“com.sun.star.chart.StackableDiagram”)’ nothing changes. I have studied the documentation and several forums, but I have no clue what I am missing. Code below.
Configuration details
Version: 7.4.3.2 (x64) / LibreOffice Community
CPU threads: 12; OS: Windows 10.0 Build 19045; Locale: nl-NL (nl_NL); UI: en-US
OK, here it goes… Please have some mercy on a poor old non-programmer nerd.
Background
Over the years I collected a rather large set of Excel spreadsheets with VBA macros for my personal finances. This year I decided to migrate them all to LibreOffice, as part of my wider migration from Windows to Linux. I am not a programmer, so I decided to use BASIC as it would be closest to VBA.
One of my spreadsheets tracks progress on our home mortgage. I keep track of all payments on interest and principal. As we are paying down extra with a fixed monthly payment and a ‘snowball’ (all savings go back as payments to the principal) the spreadsheet also calculates the expected next snowball payment, as well as a prognosis for the remainder of the mortgage. That all works fine.
The key worksheets in my Mortgage spreadsheet are ‘Months’, where I store all the data of past payments, and ‘Prognosis’, which holds a copy of ‘Months’ but also a prognosis for every month in the future.
I am now down to the last block of functionality: reporting. This is mainly a collection of charts that show the history, current status and prognosis for my mortgage based on the data in Months and Prognosis. For this I use a dedicated worksheet called ‘Charts’ in my spreadsheet. Here I can select a Chart Type from a dropdown-list, as well as some date or period related settings (I use named fields for this). See a partial screenshot below.
Partial Screenshot of Charts worksheet
When I press the ‘Update Chart’ button on my Charts worksheet, a macro called ‘ChartsGeneral’ is triggered. In this macro:
I use the date or period related settings to calculate the starting row and ending row for the data series
I then generate an empty standard linechart called ‘AdminChart’ on the Charts worksheet, with settings for the axes, the formatting, and everything
I call a second macro based on the ChartType value on Charts. In the above example the chart is called ‘Opbouw Stand van Zaken’, so I call a second macro called ChartBuildStatus.
The code for ChartsGeneral can be found below
Sub ChartsGeneral()
'Manages the Charts worksheet
'Set Worksheets
wshC = ThisComponent.Sheets.getByName("Charts")
wshM = ThisComponent.Sheets.getByName("Months")
wshP = ThisComponent.Sheets.getByName("Prognosis")
wshS = ThisComponent.Sheets.getByName("Settings")
'Define Colours
cBlack = RGB(0, 0, 0)
cGray01 = RGB(50, 50, 50)
cGray02 = RGB(191, 191, 191)
cWhite = RGB(255, 255, 255)
cDarkRed = RGB(192, 0, 0)
cPinkiDEAL = RGB(204, 0, 102) 'iDeal
cGreenCash = RGB(112, 173, 71) 'Cash Green
cBluePin = RGB(41, 65, 113) 'PIN Blue
cBlueContactless = RGB(58, 125, 193) 'Contactloos Light Blue
cOrangeVisa = RGB(246, 155, 14) 'Visa Orange
'Set Parameters
'Prognosis
ColumnOriginal = 18 'Original Rest Mortgage
ColumnRest = 17 'Actual Rest Mortgae
ColumnPaid = 16 'Reeds afgelost
ColumnPrognosis = 21 'Prognosis Rest Mortgage
ColumnInterestSavedPrognosis = 23 'Bespaarde rente prognose
ColumnInterestSaved = 26 'Bespaarde rente
ColumnExtraTotal = 14 'Column total extra cumulative
ColumnPercent = 24
ColumnPercentPrognosis = 25
'Months
XASColumn = 2
ColumnExtra = 13 'Extra repayment column
ColumnRegular = 12 'Regular repayment column
ColumnInterest = 11 'Interest payment column
ColumnMonthInterest = 3 'Interest payment column
ColumnMonthRegular = 4 'Regular repayment column
ColumnMonthTotal = 9 'Total Monthly repayment column
ColumnSnowball = 7 'Snowball per month column
ColumnWOZ = 17 'WOZ column
ColumnMortgage = 16 'Rest of mortgage column
ColumnVasteLasten = 5 'Regular Interest and Depreciation
ColumnLTV = 21 'LTV Ratio
ColumnPercentageRest = 24 'Percentage Rest Mortgage Paid This Month
ColumnWOZpercentage = 22 'WOZ percentage column
ColumnMortgagePercentage = 26 'Rest of mortgage percentage column
'X-As Values
LastMonthRow = getLastContentIndex("Months", 3)
If wshM.getCellByPosition(1, LastMonthRow).Value = (ThisComponent.NamedRanges.getByName("ChartMonth").getReferredCells.Value + 1) Then
LastMonthRow = LastMonthRow - 1
End If
LastMonth = wshM.getCellByPosition(1, LastMonthRow).Value
LastYear = wshM.getCellByPosition(0, LastMonthRow).Value
xStartRow = 3
xEndRow = LastMonthRow
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "1Y" Then
StartYear = LastYear - 1
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "2Y" Then
StartYear = LastYear - 2
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "3Y" Then
StartYear = LastYear - 3
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "5Y" Then
StartYear = LastYear - 5
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "10Y" Then
StartYear = LastYear - 10
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "15Y" Then
StartYear = LastYear - 15
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
If ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String = "20Y" Then
StartYear = LastYear - 20
StartMonth = LastMonth + 1
If StartMonth = 13 Then
StartYear = StartYear + 1
StartMonth = 1
End If
For i = xStartRow To LastMonthRow
If wshM.getCellByPosition(0, i).Value = StartYear And wshM.getCellByPosition(1, i).Value = StartMonth Then
xStartRow = i
Exit For
End If
Next i
End If
'Global Variable for BlogMarkers
ChartStartRow = StartRow
'Generate New Chart
oCharts = wshC.Charts
If oCharts.Count <> 0 then
For i = 0 to oCharts.Count-1
oChart = oCharts.getByIndex(i)
If oChart.name = "AdminChart" then
oCharts.removeByName("AdminChart")
End If
Next i
End If
Dim oRange as Object
Dim oRangeAddress(1) As New com.sun.star.table.CellRangeAddress
Dim oRect As New com.sun.star.awt.Rectangle
Dim cTitle as String
'Define Point and Size in order to change Position and Size of Chart Objects
Dim Pos_Chart As New com.sun.star.awt.Point
Dim Pos_Title As New com.sun.star.awt.Point
Dim Pos_SubTitle As New com.sun.star.awt.Point
Dim Pos_xTitle As New com.sun.star.awt.Point
Dim Pos_yTitle As New com.sun.star.awt.Point
Dim Pos_Legend As New com.sun.star.awt.Point
Dim Size_Chart As New com.sun.star.awt.Size
Dim Size_Title As New com.sun.star.awt.Size
Dim Size_SubTitle As New com.sun.star.awt.Size
Dim Size_xTitle As New com.sun.star.awt.Size
Dim Size_yTitle As New com.sun.star.awt.Size
Dim Size_Legend As New com.sun.star.awt.Size
oRange = thisComponent.getCurrentSelection.getRangeAddress
oRect.Width = 34000
oRect.Height = 19500
oRect.X = 8650
oRect.Y = 20
cTitle = "AdminChart"
oCharts.addNewByName(cTitle,oRect,oRangeAddress(), TRUE, TRUE)
oChart = oCharts.getByName(cTitle).embeddedObject
oChart.Diagram = oChart.createInstance("com.sun.star.chart.LineDiagram") 'LineDiagram
oDiagram = oChart.Diagram
'Change position and size of chart area in rectangle
oChart.RefreshAddInAllowed = True
Pos_Chart.X = 700
Pos_Chart.Y = 1600
Size_Chart.Width = oRect.Width - 1500
Size_Chart.Height = oRect.Height - 2500
oDiagram.setPosition( Pos_Chart )
oDiagram.setSize( Size_Chart )
'Title and Subtitle of Chart
'oChart.SplineType = 0
oChart.HasMainTitle = True
oChart.Title.String = cTitle
oChart.Title.CharColor = cBlack
oChart.Title.CharFontName = "Liberation Sans"
oChart.Title.CharHeight = 16 ' Font Size
oChart.Title.CharWeight = 0 ' Bold in %
oChart.Title.CharPosture = 0 ' Italics = 1
oChart.HasSubTitle = False
'oChart.SubTitle.String = "Testing the waters"
'oChart.SubTitle.CharColor = cBlue
'oChart.SubTitle.CharFontName = "Liberation Sans"
'oChart.SubTitle.CharHeight = 12 ' Font Size
'oChart.SubTitle.CharWeight = 100 ' Bold in %
'oChart.SubTitle.CharPosture = 0 ' Italics
'Chart Area colours
oDiagram.Wall.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oDiagram.Wall.FillColor = cWhite 'Chart Area Colour
oDiagram.Wall.LineStyle = com.sun.star.drawing.FillStyle.SOLID
oDiagram.Wall.LineColor = cBlack 'Chart Area Border Colour
oDiagram.Wall.LineWidth = 20
oChart.Area.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oChart.Area.FillColor = cWhite 'Full Area Colour
'Horizontal Major Grid Lines
oDiagram.HasYAxisGrid = True
oDiagram.YMainGrid.LineStyle = com.sun.star.drawing.FillStyle.SOLID
oDiagram.YMainGrid.LineColor = cGray02
oDiagram.YMainGrid.LineWidth = 20
'Vertical Major Grid Lines
oDiagram.HasXAxisGrid = False
oDiagram.XMainGrid.LineStyle = com.sun.star.drawing.FillStyle.SOLID
oDiagram.XMainGrid.LineColor = cGray02
oDiagram.XMainGrid.LineWidth = 20
'X-Axis
oDiagram.HasXAxis = True
oDiagram.HasXAxisDescription = True
oDiagram.HasXAxisTitle = True
oXaxis = oDiagram.getXAxis()
oXaxis.AxisTitle.String = "X-Values"
oXaxis.AxisTitle.CharFontName = "Liberation Sans"
oXaxis.AxisTitle.CharColor = cBlack
oXaxis.AxisTitle.CharHeight = 11 ' Font Size
oXaxis.AxisTitle.CharWeight = 0 ' Bold in %
oXaxis.AxisTitle.CharPosture = 0 ' Italics = 1
oXaxis.AutoMin = True
oXaxis.AutoMax = True
'oXaxis.Min = 1
'oXaxis.Max = 5
oXaxis.CharColor = cBlack
oXaxis.CharFontName = "Liberation Sans"
oXaxis.CharHeight = 10 ' Font Size
oXaxis.CharWeight = 100 ' Bold in %
oXaxis.CharPosture = 0 ' Italics
oXaxis.LineColor = cBlack
oXaxis.LineWidth = 20
'Primary Y-Axis
oDiagram.HasYAxis = True
oDiagram.HasYAxisDescription = True
oDiagram.HasYAxisTitle = False
oDiagram.HasYAxis = True
oYaxis = oDiagram.getYAxis()
oYaxis.AxisTitle.String = "Y-Values"
oYaxis.AxisTitle.CharFontName = "Liberation Sans"
oYaxis.AxisTitle.CharColor = cBlack
oYaxis.AxisTitle.CharHeight = 11 ' Font Size
oYaxis.AxisTitle.CharWeight = 0 ' Bold in %
oYaxis.AxisTitle.CharPosture = 0 ' Italics = 1
oYaxis.AutoMin = False
oYaxis.AutoMax = False
oYaxis.Min = 0
oYaxis.Max = 2000
oYaxis.StepMain = 250
oYaxis.CharColor = cBlack
oYaxis.CharFontName = "Liberation Sans"
oYaxis.CharHeight = 10 ' Font Size
oYaxis.CharWeight = 0 ' Bold in %
oYaxis.CharPosture = 0 ' Italics
oYaxis.LineColor = cBlack
oYaxis.LineWidth = 20
oYaxis.LinkNumberFormatToSource = False
oYaxis.NumberFormat = "114"
oChart.HasLegend = 1
oLegend = oChart.getLegend()
oLegend.AutomaticPosition = True
oLegend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM
oLegend.CharHeight = 10 ' Font Size
oLegend.CharWeight = 0 ' Bold in %
oLegend.CharFontName = "Liberation Sans"
oLegend.FillColor = cWhite
oLegend.LineColor = cWhite
oLegend.CharColor = cBlack
oLegend.CharPosture = 0 'Italics
oDiagram.Lines = True
oDiagram.LineColor = cDarkRed
oDiagram.LineWidth = 20
'oChart.DataSourceLabelsInFirstColumn = True
'oChart.DataSourceLabelsInFirstRow = False
'Call Chart Procedure
If ThisComponent.NamedRanges.getByName("ChartType").getReferredCells.String = "Opbouw Stand van Zaken" Then
cTitle = "Opbouw Eigen Woning " & ThisComponent.NamedRanges.getByName("ChartPeriod").getReferredCells.String
Call ChartBuildStatus(xStartRow, xEndRow, cTitle)
End If
End Sub
Once the macro ChartBuildStatus is called, that macro contains the following actions:
I change the chart type of AdminChart to AreaDiagram. That shows up correctly on my screen.
I then try to make it a stacked diagram. But it won’t…
After that, I change some formatting characteristics of the chart, like axis titles and number formats
And I generate the category and data series calling on two other macro’s, CreateDataSequence() and CreateDataSeries_Chart(). I don’think they are the problem, they work correctly with other non-stacked line charts and the series
I have tried a number of things, including moving the stacking code to the end of the macro. But I cannot get it to work correctly. I must be overlooking something or doing something very stupid. So after literally days of trying I am pinning my hopes on the community. Anybody who can shed some light on this?
Sub ChartBuildStatus(xStartRow As Long, xEndRow As Long, cTitle As String)
'Define Colours
cBlack = RGB(0, 0, 0)
cGray01 = RGB(50, 50, 50)
cGray02 = RGB(191, 191, 191)
cWhite = RGB(255, 255, 255)
wshC = ThisComponent.Sheets.getByName("Charts")
wshM = ThisComponent.Sheets.getByName("Months")
oCharts = wshC.Charts
oChart = oCharts.getByName("AdminChart").embeddedObject
oChart.Diagram = oChart.createInstance("com.sun.star.chart.AreaDiagram")
'Stackable Diagram
oChart.Diagram = oChart.createInstance("com.sun.star.chart.StackableDiagram")
oDiagram = oChart.getDiagram()
oChart.setDiagram(oDiagram)
oDiagram = oChart.getDiagram()
With oDiagram
.Stacked = True
.Percent = False
.Vertical = False
End With
ChartUnit = 50000
'Specific Chart Adjustments
oXaxis = oDiagram.getXAxis()
oYaxis = oDiagram.getYAxis()
'Ymax And Ymin
oYaxis.AutoMax = True
oYaxis.Min = 0
'Chart details
oChart.Title.String = cTitle
oDiagram.HasXAxisTitle = False
oYaxis.AxisTitle.String = "EUR"
oYaxis.StepMain = ChartUnit
oYaxis.NumberFormat = "115" ' #,##0
'Data Series Generator
oDataProvider = oChart.getDataProvider()
oDiagram = oChart.getFirstDiagram()
oCooSys = oDiagram.getCoordinateSystems()
oCoods = oCooSys(0) ' this chart has only a coordinate system
oChartTypes = oCoods.getChartTypes() ' chart type one by one
oChartType = oChartTypes(0)
'Data Ranges
xEndRow = getLastContentIndex ("Months", 3 )
Xrange = "Months.C" & (xStartRow + 1) & ":C" & (xEndRow + 1) 'yyyymm
Y1range = "Months.S" & (xStartRow + 1) & ":S" & (xEndRow + 1) 'Overwaarde
Y2range = "Months.T" & (xStartRow + 1) & ":T" & (xEndRow + 1) 'Eigen Geld
Y3range = "Months.M" & (xStartRow + 1) & ":M" & (xEndRow + 1) 'Reguliere Aflossing
Y4range = "Months.N" & (xStartRow + 1) & ":N" & (xEndRow + 1) 'Extra Aflossing
Y5range = "Months.Q" & (xStartRow + 1) & ":Q" & (xEndRow + 1) 'Restant Hypotheek
'Prepare for Data Series
oDataProvider = oChart.getDataProvider()
oDiagram = oChart.getFirstDiagram()
oCooSys = oDiagram.getCoordinateSystems()
oCoods = oCooSys(0) ' this chart has only a coordinate system
oChartTypes = oCoods.getChartTypes() ' chart type one by one
oChartType = oChartTypes(0)
'X-Axis Data series
dim categorySequence as object, categoryRange as string
dim coordinateSystem as object, axis as object
dim scaleData as new com.sun.star.chart2.ScaleData
categorySequence = CreateUnoService("com.sun.star.chart2.data.LabeledDataSequence")
categorySequence.setValues(CreateDataSequence(oDataProvider, Xrange, "categories"))
coordinateSystem = oDiagram.getCoordinateSystems()(0)
axis = coordinateSystem.getAxisByDimension(0, 0)
scaleData = axis.getScaleData()
scaleData.Categories = categorySequence
axis.setScaleData(scaleData)
'Y-Axis Data series
oDataSeriesList = oChartType.getDataSeries()
Dim oNewDataSeriesList(4) As Object ' new data series
oSeries1 = CreateDataSeries_Chart(oDataProvider, Xrange, Y1range, "Overwaarde")
oSeries1.Color = RGB(197, 224, 180)
oSeries1.LineWidth = 60
oNewDataSeriesList(0) = oSeries1
oSeries2 = CreateDataSeries_Chart(oDataProvider, Xrange, Y2range, "EigenGeld")
oSeries2.Color = RGB(0, 176, 80)
oSeries2.LineWidth = 60
oNewDataSeriesList(1) = oSeries2
oSeries3 = CreateDataSeries_Chart(oDataProvider, Xrange, Y3range, "Aflossing")
oSeries3.Color = RGB(146, 208, 80)
oSeries3.LineWidth = 60
oNewDataSeriesList(2) = oSeries3
oSeries4 = CreateDataSeries_Chart(oDataProvider, Xrange, Y4range, "AflossingExtra")
oSeries4.Color = RGB(255, 215, 0)
oSeries4.LineWidth = 60
oNewDataSeriesList(3) = oSeries4
oSeries5 = CreateDataSeries_Chart(oDataProvider, Xrange, Y5range, "RestHypotheek")
oSeries5.Color = RGB(192, 0, 0)
oSeries5.LineWidth = 60
oNewDataSeriesList(4) = oSeries5
'Update chart (only the charttype is updated)
oChartType.setDataSeries(oNewDataSeriesList)
End Sub
On the left the chart as it looks now in my LibreOffice Calc spreadsheet, on the right the chart as I want it to look based on my current Excel sheet.
Left: LibreOffice / Right: Excel (how I want it)
For the sake of completeness, please find the additional macro’s CreateDataSequence() and CreateDataSeries_Chart() below.
CreateDataSequence()
Function CreateDataSequence( oDataProvider As Object, sRangeRepresentation As String, sRole As String ) As Object
Dim oDataSequence As Object
On Error GoTo Handler
' create .chart2.data.DataSequence from range representation
oDataSequence = oDataProvider.createDataSequenceByRangeRepresentation(sRangeRepresentation)
If NOT IsNull(oDataSequence) Then
oDataSequence.Role = sRole
End If
Handler:
CreateDataSequence = oDataSequence
End Function
CreateDataSeries_Chart()
Function CreateDataSeries_Chart( oDataProvider As Object, sXRangeRepresentation As String, sYRangeRepresentation As String, sLabelRangeRepresentation As String ) As Object
Dim oNewDataSeries As Object
oNewDataSeries = CreateUnoService("com.sun.star.chart2.DataSeries")
Dim oData(1) As Object ' x and y: .chart2.data.XLabeledDataSequence
' Y
oDataY = CreateUnoService("com.sun.star.chart2.data.LabeledDataSequence")
oSequenceY = CreateDataSequence(oDataProvider, sYRangeRepresentation, "values-y")
If NOT IsNull(oSequenceY) Then
oDataY.setValues(oSequenceY)
If NOT ((IsMissing(sLabelRangeRepresentation)) AND (sLabelRangeRepresentation <> "")) Then
oSequenceLabel = CreateDataSequence(oDataProvider, sLabelRangeRepresentation, "label") ' ""
oDataY.setLabel(oSequenceLabel) ' oSequenceLabel label is used as name
End If
End If
' X
oDataX = CreateUnoService("com.sun.star.chart2.data.LabeledDataSequence")
oSequenceX = CreateDataSequence(oDataProvider, sXRangeRepresentation, "values-x")
If NOT IsNull(oSequenceX) Then
oDataX.setValues(oSequenceX)
End If
' set x and y data to series
aData = Array(oDataY, oDataX)
oNewDataSeries.setData(aData)
CreateDataSeries_Chart = oNewDataSeries
End Function
Related
Condition only run ONCE (instead on all bars)
On checking for condition gap(high-low) > 0.1%(which is met multiple times), the label only gets rendered ONCE (instead of on relevant bars within 25 bar lookback). Plz provide a solution. CODE : Historical Bars //#version=5 indicator("PriceMomemtum",overlay = true,max_bars_back = 25) gap = (math.abs(high - low)/low ) * 100 //var gap = (math.abs(high - low)/low ) * 100 if gap > 0.1 var lbl = label.new(x = bar_index,y = na , text = na ,text_font_family = font.family_default ,xloc = xloc.bar_index,yloc =yloc.abovebar,style = label.style_arrowdown ,textcolor = color.white,size =size.small,textalign = text.align_left,tooltip = na) label.set_text(lbl,str.tostring(gap,"#.00")+"%") label.set_xy(lbl,bar_index,high ) Realtime Bars //#version=5 indicator("PriceMomemtum",overlay = true,max_bars_back = 25) if barstate.isrealtime gap = (math.abs(high - low)/low ) * 100 //var gap = (math.abs(high - low)/low ) * 100 if gap > 0.1 var lbl = label.new(x = bar_index,y = na , text = na ,text_font_family = font.family_default ,xloc = xloc.bar_index,yloc =yloc.abovebar,style = label.style_arrowdown ,textcolor = color.white,size =size.small,textalign = text.align_left,tooltip = na) label.set_text(lbl,str.tostring(gap,"#.00")+"%") label.set_xy(lbl,bar_index,high ) alert(str.tostring(time(syminfo.timezone)) + "(PriceMomentum)", alert.freq_once_per_bar)
Have you tried defining "lbl" variable without "var"? result
Remove Marks on Charts
I have a problem with my code, I want to evaluate a Report with Charts. What my Macro currently does is, Create for every single column a Row for a nominal, upper, lower tolerance. Then It creates with this values a chart. After this it starts with the Sorting and then it removes the Marker Points, but here my Problems already start. I would like to create the charts later for example on pos A100 or A50 or something. Then the Marker Points, I would like to keep the Points on the result line but not on the 3 created, but I found no way Remove the Markers, but it removes all, i would really like to remove them only for FullSeriesCollection(2).format.Line FullSeriesCollection(3).format.Line FullSeriesCollection(4).format.Line Would be nice if someone would have an idea.. :) Thanks in advance, ' Unload UFormTools UFormTools.Hide Application.ScreenUpdating = False Sheets("Original Values").Select Dim lngC As Long, lngR As Long Dim i As Long Dim c As Byte Application.ScreenUpdating = False With ActiveSheet lngC = (.Cells(17, 4).End(xlToRight).Column - 4) * 4 For i = 4 To lngC Step 4 lngR = .Cells(.Rows.Count, i).End(xlUp).Row For c = 1 To 3 .Columns(i + c).EntireColumn.Insert Next c .Cells(17, i).AutoFill Destination:=.Range(.Cells(17, i), .Cells(17, i + 3)), Type:=xlFillCopy .Range(.Cells(28, i + 1), .Cells(lngR, i + 1)).Value = .Cells(18, i).Value .Range(.Cells(28, i + 2), .Cells(lngR, i + 2)).Value = .Cells(18, i).Value + .Cells(19, i).Value .Range(.Cells(28, i + 3), .Cells(lngR, i + 3)).Value = .Cells(18, i).Value + .Cells(20, i).Value .Shapes.AddChart2(332, xlLineMarkers).Select With ActiveChart .SetSourceData Source:=Union(ActiveSheet.Range(ActiveSheet.Cells(17, i), ActiveSheet.Cells(17, i + 3)), _ ActiveSheet.Range(ActiveSheet.Cells(28, i), ActiveSheet.Cells(lngR, i + 3))) ' .Legend.Delete .ChartTitle.Text = ActiveSheet.Cells(17, i).Value .ChartTitle.format.TextFrame2.TextRange.Characters.Text = ActiveSheet.Cells(17, i).Value With .ChartTitle.format.TextFrame2.TextRange.Characters(1, Len(ActiveSheet.Cells(17, i).Value)).ParagraphFormat .TextDirection = msoTextDirectionLeftToRight .Alignment = msoAlignCenter End With With .FullSeriesCollection(3).format.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 End With With .FullSeriesCollection(4).format.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 End With With .FullSeriesCollection(2).format.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Visible = msoTrue .DashStyle = msoLineDash .Weight = 1.5 End With With .FullSeriesCollection(1).format.Line .Visible = msoTrue .Weight = 3 End With .FullSeriesCollection(1).Smooth = True .Axes(xlValue).MinimumScaleIsAuto = True .Axes(xlValue).MinimumScaleIsAuto = True End With Next i End With ' Sort and Arrange Charts, but another Position to Start would be nice.. (for example A100) Dim MyWidth As Single, MyHeight As Single Dim NumWide As Long Dim iChtIx As Long, iChtCt As Long MyWidth = 300 MyHeight = 200 NumWide = 4 iChtCt = ActiveSheet.ChartObjects.Count For iChtIx = 1 To iChtCt With ActiveSheet.ChartObjects(iChtIx) .Width = MyWidth .Height = MyHeight .Left = ((iChtIx - 1) Mod NumWide) * MyWidth .Top = Int((iChtIx - 1) / NumWide) * MyHeight End With Next ' Remove the Markers, but it removes all, i would really like to remove them only for ' FullSeriesCollection(2).format.Line ' FullSeriesCollection(3).format.Line ' FullSeriesCollection(4).format.Line Dim cht As ChartObject Dim srs As Series Dim MarkerCount As Long For Each cht In ActiveSheet.ChartObjects cht.Activate For Each srs In ActiveChart.SeriesCollection If srs.MarkerStyle <> xlMarkerStyleNone Then srs.MarkerStyle = xlMarkerStyleNone MarkerCount = MarkerCount + 1 End If Next srs Next cht Range("A1").Select Application.ScreenUpdating = True
Align series by value in DevExpress XtraCharts
I have a DevExpress XtraChart object with several series, all of type: line. I have a requirement from a client to align the series by the max value of each series. This is without regard to the attached axis, has anyone done this before?
Although I was interested in displaying this on the chart element, the 'work' was done on the underlying DataSet. I was able to achieve this by looping through the series collection, deriving the max value of the first series, through a SQL query, and then each subsequent series, and noting the difference, and then adding or subtracting the difference at the DataSet level. Here's the code: Private Sub cbAlignPeaks_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cbAlignPeaks.CheckedChanged Dim dt As DataTable = chart.DataSource Dim Row() As Data.DataRow Dim s As Series = Nothing Dim dtr As DataTableReader = Nothing Dim maxTimeGet, maxTimeSet, diff As Decimal Me.Cursor = Cursors.WaitCursor If cbAlignPeaksPre.Checked Then For i As Integer = 0 To chartPreTim.Series.Count - 1 s = chartPreTim.Series(i) If _offsets.Count = chartPreTim.Series.Count - 1 Then If i > 0 Then diff = _offsets(s.DataFilters(0).Value) Row = dt.Select("BORING_NAME = '" & s.Name & "'") For k As Integer = 0 To Row.Count - 1 Row(k)("TIME_SEC") = Row(k)("TIME_SEC") + diff Next End If Else If i = 0 Then 'get adjustment info dtr = getDetectorMax(s.DataFilters(0).Value, cbDetectors.Text, timType.PRE) ' <-- getDetectorMax runs a SQL query returning the max value If dtr.Read Then maxTimeGet = dtr("TIME_SEC") End If Else 'set adjustment info dtr = Nothing dtr = getDetectorMax(s.DataFilters(0).Value, cbDetectors.Text, timType.PRE) If dtr.Read Then maxTimeSet = dtr("TIME_SEC") End If If maxTimeGet > maxTimeSet Then diff = maxTimeGet - maxTimeSet _offsets.Add(s.DataFilters(0).Value, diff) Row = dt.Select("BORING_NAME = '" & s.DataFilters(0).Value & "'") For k As Integer = 0 To Row.Count - 1 Row(k)("TIME_SEC") = Row(k)("TIME_SEC") + diff Next Else diff = maxTimeSet - maxTimeGet _offsets.Add(s.DataFilters(0).Value, diff * -1) Row = dt.Select("BORING_NAME = '" & s.DataFilters(0).Value & "'") For k As Integer = 0 To Row.Count - 1 Row(k)("TIME_SEC") = Row(k)("TIME_SEC") - diff Next End If End If End If Next Else For i As Integer = 1 To chartPreTim.Series.Count - 1 ' We skip item 0 as that's the baseline s = chartPreTim.Series(i) diff = _offsets(s.DataFilters(0).Value) Row = dt.Select("BORING_NAME = '" & s.DataFilters(0).Value & "'") For k As Integer = 0 To Row.Count - 1 Row(k)("TIME_SEC") = Row(k)("TIME_SEC") - diff Next Next End If chartPreTim.RefreshData() chartPreTim.Refresh() Me.Cursor = Cursors.Default End Sub
Run time error 9 when using arrary in Macro
I have been using the followng Macro and it works fine: Sub PremTable() Dim i, m, j As Integer Dim PDFDiv, PDFClass, PDFSex, PDFPlan, LimAge As Variant Dim FlagD, FlagC, Band, FlagP, FlagB, IssAge, Dur As Integer PDFClass = Array("N", "S") PDFSex = Array("M", "F") PDFDiv = Array("G", "E") PDFPlan = Array(10, 20, 30) LimAge = Array(70, 60, 50) j = 0 For FlagD = 1 To 2 Range("div").Value = PDFDiv(FlagD) For FlagP = 1 To 3 Range("plan").Value = PDFPlan(FlagP) For Band = 1 To 3 Range("band").Value = Band For FlagS = 1 To 2 Range("sex").Value = PDFSex(FlagS) For FlagC = 1 To 2 Range("class").Value = PDFClass(FlagC) m = 18 For i = 1 To Range("LimAge").Value - 17 Range("IssAge").Offset(i + j, 0) = m Range("age").Value = Range("IssAge").Offset(i + j, 0) Worksheets("input").Range("J4:J76").Copy Worksheets("Premium Tables").Range("M1").Offset(i + j, 0).PasteSpecial xlPasteValues, Transpose:=True Range("DIV2").Offset(i + j, 0) = Range("Div") Range("PLAN2").Offset(i + j, 0) = Range("plan") Range("BAND2").Offset(i + j, 0) = Range("band") Range("SEX2").Offset(i + j, 0) = Range("sex") Range("CLASS2").Offset(i + j, 0) = Range("class") m = m + 1 Next i j = j + i - 1 Next FlagC Next FlagS Next Band Next FlagP Next FlagD End Sub Now I have another very similar spreatsheet that I want to use this macro to creat tables, but it always give me the "run time error 9" for all of the arrays having text format variables (for example: Range("class").Value = PDFClass(FlagC) causing an runtime error 9) Please advise! Thanks very much!
Can I perform a count distinct query on values selected from a listbox?
I have a select distinct query that works find on selected fields from a listbox. However I would like it to be a count distinct and I can't seem to get the code right. Below is my working code for select distinct. Thanks in advance for any assistance I've searched for count distinct questions but I don't see any specific to listbox selections. Private Sub CmdDistinctVal_Click() Dim cn1 As ADODB.Connection Dim rs1 As New ADODB.Recordset Dim cmd1 As New ADODB.Command Dim varItem As Variant Dim aFields() As aArray Dim NumRows As Integer Dim NumFields As Integer Dim colcount As Integer Dim colwidths As String Dim strRow As String Dim cnt1 As Integer Dim cnt2 As Integer 'On Error GoTo Err_ CmdDistinctVal_Click 'cmd1.ActiveConnection = CurrentProject.Connection Me.DistinctResultsFldVal.RowSource = "" ReDim aFields(50) For cnt1 = 1 To 50 ReDim aFields(cnt1).fValue(6000) Next NumRows = 0 colcount = 0 For Each varItem In Me!ResultsFieldList.ItemsSelected colcount = colcount + 1 aFields(colcount).fName = Me!ResultsFieldList.ItemData(varItem) NumFields = 0 rs1.Open "SELECT DISTINCT " & Me!ResultsFieldList.ItemData(varItem) & " FROM [Results Report]", CurrentProject.Connection, adOpenKeyset, adLockOptimistic If rs1.RecordCount > NumRows Then NumRows = rs1.RecordCount strRow = strRow & Me!ResultsFieldList.ItemData(varItem) & ";" While Not rs1.EOF NumFields = NumFields + 1 If NumFields > NumRows Then NumRows = NumFields End If aFields(colcount).fValue(NumFields) = rs1(0) & "" rs1.MoveNext Wend rs1.Close Next varItem strRow = Left(strRow, Len(strRow) - 1) Me.DistinctResultsFldVal.ColumnCount = colcount Me.DistinctResultsFldVal.ColumnWidths = Mid(colwidths, 2) Me.DistinctResultsFldVal.AddItem (strRow) For cnt1 = 1 To NumRows strRow = "" For cnt2 = 1 To colcount If aFields(cnt2).fValue(cnt1) = "" Then strRow = strRow & ";" Else strRow = strRow & aFields(cnt2).fValue(cnt1) & ";" End If Next strRow = Left(strRow, Len(strRow) - 1) Me.DistinctResultsFldVal.AddItem (strRow) Next 'Err_ CmdDistinctVal_Click: 'MsgBox "All null values were found in one or more of your selected fields" End Sub