makeStapleChart, example in LibreOffice

sub makeStapleChart
' Script first transpose table earlier loaded vith sub loadCSV.
' Then it creates a chart from the transposed table
' Require user to make a selection in table first
' ToDo: Figure out if hatches can be made in staples
' ToDo: finding better solution saving file then "on error resume next",
'  to avoid  "com.sun.star.task.ErrorCodeIOException"
'  could be caused by a dialog asking to keep odt-format
' ToDo: file properties could be overridden by local properties, need more testing
' Folke Larsson  Boden, Sweden 2017

Dim ind as Integer ' for for loops
Dim splitChar as String
' document, range and cell variables
Dim myDoc  as object
Dim mySelection  as object
Dim myDispatcher as Object
Dim mySheets as Object
Dim myCurrSheet as Object
Dim myCell as Object
Dim myCellString as String
Dim myColumns as Object
Dim myRows as Object
Dim nrRows as Integer
Dim startRange as Object   ' the selection user made
Dim numberRange as Object
Dim rangeColumnHeader as Object
Dim rangeRowHeaders as Object
Dim colorHeaderCells as String
Dim colorNumberCells as String
Dim to_point_args(0) as new com.sun.star.beans.PropertyValue
Dim transpose_args(5) as new com.sun.star.beans.PropertyValue
Dim myRangeAddress(0) As New com.sun.star.table.CellRangeAddress
Dim ul_tempTableRowNum as Integer
Dim lr_tempTable_rowNum as Integer
Dim ul_tempTablePoint as String
Dim ur_tempTablePoint as String

' chart vaiables
Dim myCharts as Object
Dim myCurrChart as Object
Dim myDiagram as Object
Dim myCoords as Object
Dim myCurrCoord as Object
Dim myChartTypes as Object
Dim myCurrChartType as Object
Dim myDataSeries as Object
Dim myRect As New com.sun.star.awt.Rectangle
Dim chartVerticalRow as Integer
Dim chartVerticalPos as Integer
Dim YAxisTitle as String
Dim myHatch As New com.sun.star.drawing.Hatch
Dim header1 as String
Dim header2 as String
Dim header1Array(10) as String
Dim header2Array(10) as String
Dim titleString as string
Dim subtitleString as String

' char, column variables
Dim chartHeight as Integer
Dim chartWidth as Integer
Dim colorDataserie0 as String
Dim colorDataserie1 as String
Dim colorWall as String
Dim colorLegend as String
Dim charHeight1 as String
Dim charHeight2 as Integer
Dim charHeight3 as Integer
Dim charColor1 as Integer
Dim charWeight1 as Integer
Dim charWeight2 as Integer
Dim charColor2 as Integer
Dim columnWidth1 as Integer
Dim columnWidth2 as Integer

' save file varibles
Dim fileName as String
Dim myFileProps(2) as new com.sun.star.beans.PropertyValue
Dim fieldSeparator As Integer
Dim textDelimiter as Integer
Dim charset as Integer
Dim firstLine as Integer
Dim columnFormat as String
Dim languageId as Integer
Dim QuotedfFeldAsText as Boolean
Dim DetectSpecialNumbers as Boolean
Dim SaveCellContentsAsShown as Boolean
Dim filterOptionString as String
Dim fileSuffix as String
Dim saveFilePath as String
Dim saveFileName as String

 myDoc   = ThisComponent.CurrentController.Frame
 myDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
 mySheets = ThisComponent.getSheets()
 myCurrSheet = mySheets.getByIndex(0)
 startRange = thisComponent.getCurrentSelection.getRangeAddress
 nrRows = startRange.EndColumn

 if (nrRows < 2) Then
  MsgBox " apparently, no selection of cells ! "
  stop
 end if

' arrays and variable from cells below table
 splitChar = "_"
 header1 =  myCurrSheet.getCellByPosition(0, 4).String
 header2 =  myCurrSheet.getCellByPosition(0, 5).String
 fileName = myCurrSheet.getCellByPosition(0, 6).String
 header1Array =  split(header1, splitChar)
 header2Array =  split(header2, splitChar)



 ind = 1
 myCell = myCurrSheet.getCellByPosition(0, ind)
 myCellString = myCell.getString()

 Do while Len(myCellString) > 1
  ind = ind+1
  myCell = myCurrSheet.getCellByPosition(0, ind)
  myCellString = myCell.getString()
 Loop
 ul_tempTableRowNum = ind + 6


 charHeight1 = 10
 charHeight2 = 11
 charHeight3 = 12
 charWeight1 = 110
 charWeight2 = 140
 charColor1 =  10
 charColor2 =  11
 columnWidth1 = 5000
 columnWidth2 = 2500

 chartHeight = 9000
 chartWidth =  14000
 colorDataserie0 = RGB(115, 230, 115)
 colorDataserie1 = RGB(235, 235, 900)
 colorWall =   RGB(220, 220, 250)
 colorLegend = RGB(150, 150, 220)
 colorHeaderCells =  RGB(210, 210, 210)
 colorNumberCells  = RGB(250, 250, 200)

 for ind = 1 to UBound(header1Array)
  titleString = titleString + header1Array(ind) + " "
 next ind
 titleString = Mid(titleString, 1, Len(titleString) -1 )

 for ind = 1 to UBound(header2Array)
  subtitleString = subtitleString + header2Array(ind) + " "
 next ind
 subtitleString = Mid(subtitleString, 1, Len(subtitleString) -1 )

 YAxisTitle = header2Array(0)

 lr_tempTable_rowNum = ul_tempTableRowNum + nrRows
 ul_tempTablePoint = "$A$" + ul_tempTableRowNum
 ur_tempTablePoint = "$C$" + ul_tempTableRowNum

' adjusting columns, setting background color in cells etc
 numberRange = myCurrSheet.getCellRangeByPosition(startRange.StartColumn + 1, 1, startRange.EndColumn, 2)
 numberRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
 numberRange.CellBackColor = colorNumberCells

 rangeColumnHeader = myCurrSheet.getCellRangeByPosition(1,  0, startRange.EndColumn , 0)
 rangeColumnHeader.setPropertyValue("CharWeight",  charWeight1)
 rangeColumnHeader.setPropertyValue("CharHeight",  charHeight2)  'charHeight1)
 rangeColumnHeader.setPropertyValue("CharColor",   charColor1)
 rangeColumnHeader.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
 rangeColumnHeader.CellBackColor = colorHeaderCells

 rangeRowHeaders = myCurrSheet.getCellRangeByPosition(startRange.StartColumn,  1, startRange.StartColumn , 2)
 rangeRowHeaders.setPropertyValue("CharWeight",  charWeight2)
 rangeRowHeaders.setPropertyValue("CharHeight",  charHeight3) ' charHeight2)
 rangeRowHeaders.setPropertyValue("CharColor",   charColor1)
 rangeRowHeaders.CellBackColor = colorHeaderCells

 myColumns = myCurrSheet.getColumns()
 myColumns.getByIndex(0).width = columnWidth1
 for ind = 1 to nrRows
  myColumns.getByIndex(ind).width =  columnWidth2
 next ind

 myRows = myCurrSheet.getRows()
 myRows.OptimalHeight = true

 ' copy selected cells and paste with transpose below it
 to_point_args(0).Name = "ToPoint"
 to_point_args(0).Value = startRange
 transpose_args(0).Name = "Flags"
 transpose_args(0).Value = "SV"
 transpose_args(1).Name = "FormulaCommand"
 transpose_args(1).Value = 0
 transpose_args(2).Name = "SkipEmptyCells"
 transpose_args(2).Value = false
 transpose_args(3).Name = "Transpose"
 transpose_args(3).Value = true
 transpose_args(4).Name = "AsLink"
 transpose_args(4).Value = false
 transpose_args(5).Name = "MoveMode"
 transpose_args(5).Value = 4
 myDispatcher.executeDispatch(myDoc, ".uno:GoToCell", "", 0, to_point_args())
 myDispatcher.executeDispatch(myDoc, ".uno:Copy", "", 0, Array())
 to_point_args(0).Value =  ul_tempTablePoint
 myDispatcher.executeDispatch(myDoc, ".uno:GoToCell", "", 0, to_point_args())
 myDispatcher.executeDispatch(myDoc, ".uno:InsertContents", "", 0, transpose_args()

' adjust headers in temp table
 myCell = myCurrSheet.getCellByPosition(1,  ul_tempTableRowNum-1)
 myCell.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)

 myCell = myCurrSheet.getCellByPosition(2,  ul_tempTableRowNum-1)
 myCell.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)

' todo, not figured out how to make hatch-pattern in staples
 myHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE
 myHatch.Color = RGB(64,64,64)
 myHatch.Distance = 20
 myHatch.Angle = 450

' the chart
 chartVerticalRow = ul_tempTableRowNum -1 + nrRows +6
 chartVerticalPos = chartVerticalRow*450
 myRect.Width = chartWidth
 myRect.Height = chartHeight
 myRect.X = 500
 myRect.Y = chartVerticalPos  '10000

 myRangeAddress(0).Sheet = 0
 myRangeAddress(0).StartColumn = 0
 myRangeAddress(0).StartRow = ul_tempTableRowNum -1
 myRangeAddress(0).EndColumn = 2
 myRangeAddress(0).EndRow =  ul_tempTableRowNum -1 + nrRows

 myCharts = myCurrSheet.Charts
 myCharts.addNewByName("chart1", myRect, myRangeAddress(),TRUE, TRUE)
 myCurrChart = myCharts.getByName("chart1").embeddedObject

 myCurrChart.Diagram = myCurrChart.createInstance("com.sun.star.chart.BarDiagram")
 myCurrChart.HasMainTitle = True
 myCurrChart.Title.String = titleString
 myCurrChart.Subtitle.String = subtitleString
 myCurrChart.Diagram.YAxis.AxisTitle.String = YAxisTitle
 myCurrChart.HasLegend = True

 myCurrChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.RIGHT
 myCurrChart.Legend.FillStyle = com.sun.star.drawing.FillStyle.SOLID
 myCurrChart.Legend.FillColor = colorLegend
 myCurrChart.Legend.CharHeight = charHeight1 ' charHeight0' 10

 ' Wall is background to staples, Area is for whole chart
 myCurrChart.Area.FillStyle = com.sun.star.drawing.FillStyle.BITMAP
 myCurrChart.Area.FillBitmapName = "Marble"
 myCurrChart.Area.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
  myCurrChart.Area.FillTransparence = "20%"
 myCurrChart.Area.LineTransparence = "50%"

 myCurrChart.Diagram.Wall.FillStyle = com.sun.star.drawing.FillStyle.SOLID
 myCurrChart.Diagram.Wall.FillColor = colorWall
 myCurrChart.Diagram.Wall.FillTransparence = "30%"
 myCurrChart.Diagram.Wall.LineTransparence = "50%"

 myDiagram = myCurrChart.getFirstDiagram()
 myCoords = myDiagram.getCoordinateSystems()
 myCurrCoord = myCoords(0)
 myChartTypes = myCurrCoord.getChartTypes()
 myCurrChartType = myChartTypes(0)
 myDataSeries = myCurrChartType.getDataSeries()
 myDataSeries(0).Color = colorDataserie0
 myDataSeries(1).Color = colorDataserie1
 columnFormat = "1/1"
 for ind = 2 to nrRows
   columnFormat =  columnFormat + "/" + ind + "/10"
 next ind

' saving the file, could also be closed after
 saveFilePath = "file:///C:/Users/ ... /OneDrive/Offentligt/excel/"
 fieldSeparator = 44  ' ","
 textDelimiter =  34  ' """
 charset = 11         ' ASCII/US (Western)
 firstLine = 1
 languageId = 1033 ' English US
 quotedfFeldAsText = false
 DetectSpecialNumbers = false
 saveCellContentsAsShown = true
 fileSuffix = ".xls"
 saveFileName = saveFilePath + fileName + "test1" + fileSuffix
 filterOptionString = "" + fieldSeparator + ", " + textDelimiter + ", " + charset + ", " + firstLine + ", " + columnFormat + ", " + languageId + ", " + quotedfFeldAsText + ", " + DetectSpecialNumbers + ""
 myFileProps(0).Name = "FilterName"
 myFileProps(0).Value = "MS Excel 97"
 myFileProps(1).Name = "FilterOptions"
 myFileProps(1).Value = filterOptionString
 myFileProps(2).Name = "MacroExecutionMode"
 myFileProps(2).Value = 4

 on error resume next
 thisComponent.storeToURL(saveFileName, myFileProps)
 'thisComponent.close(true)
 'thisComponent.storeAsURL(saveFileName, myFileProps) ' changing name om document keeping it open
end sub ' makeStapleChart