Advertisement
FolkeLarsson

makeStapleChart, example in LibreOffice

Jan 3rd, 2017
1,052
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. sub makeStapleChart
  2. ' Script first transpose table earlier loaded vith sub loadCSV.
  3. ' Then it creates a chart from the transposed table
  4. ' Require user to make a selection in table first  
  5. ' ToDo: Figure out if hatches can be made in staples
  6. ' ToDo: finding better solution saving file then "on error resume next",
  7. '  to avoid  "com.sun.star.task.ErrorCodeIOException"
  8. '  could be caused by a dialog asking to keep odt-format
  9. ' ToDo: file properties could be overridden by local properties, need more testing
  10. ' Folke Larsson  Boden, Sweden 2017
  11.  
  12. Dim ind as Integer ' for for loops
  13. Dim splitChar as String
  14. ' document, range and cell variables
  15. Dim myDoc  as object
  16. Dim mySelection  as object
  17. Dim myDispatcher as Object
  18. Dim mySheets as Object
  19. Dim myCurrSheet as Object
  20. Dim myCell as Object
  21. Dim myCellString as String
  22. Dim myColumns as Object
  23. Dim myRows as Object
  24. Dim nrRows as Integer
  25. Dim startRange as Object   ' the selection user made
  26. Dim numberRange as Object
  27. Dim rangeColumnHeader as Object
  28. Dim rangeRowHeaders as Object
  29. Dim colorHeaderCells as String
  30. Dim colorNumberCells as String
  31. Dim to_point_args(0) as new com.sun.star.beans.PropertyValue
  32. Dim transpose_args(5) as new com.sun.star.beans.PropertyValue
  33. Dim myRangeAddress(0) As New com.sun.star.table.CellRangeAddress
  34. Dim ul_tempTableRowNum as Integer
  35. Dim lr_tempTable_rowNum as Integer
  36. Dim ul_tempTablePoint as String
  37. Dim ur_tempTablePoint as String
  38.  
  39. ' chart vaiables
  40. Dim myCharts as Object
  41. Dim myCurrChart as Object
  42. Dim myDiagram as Object
  43. Dim myCoords as Object
  44. Dim myCurrCoord as Object
  45. Dim myChartTypes as Object
  46. Dim myCurrChartType as Object
  47. Dim myDataSeries as Object
  48. Dim myRect As New com.sun.star.awt.Rectangle
  49. Dim chartVerticalRow as Integer
  50. Dim chartVerticalPos as Integer
  51. Dim YAxisTitle as String
  52. Dim myHatch As New com.sun.star.drawing.Hatch
  53. Dim header1 as String
  54. Dim header2 as String
  55. Dim header1Array(10) as String
  56. Dim header2Array(10) as String
  57. Dim titleString as string
  58. Dim subtitleString as String
  59.  
  60. ' char, column variables
  61. Dim chartHeight as Integer
  62. Dim chartWidth as Integer
  63. Dim colorDataserie0 as String
  64. Dim colorDataserie1 as String
  65. Dim colorWall as String
  66. Dim colorLegend as String
  67. Dim charHeight1 as String
  68. Dim charHeight2 as Integer
  69. Dim charHeight3 as Integer
  70. Dim charColor1 as Integer
  71. Dim charWeight1 as Integer
  72. Dim charWeight2 as Integer
  73. Dim charColor2 as Integer
  74. Dim columnWidth1 as Integer
  75. Dim columnWidth2 as Integer
  76.  
  77. ' save file varibles
  78. Dim fileName as String
  79. Dim myFileProps(2) as new com.sun.star.beans.PropertyValue
  80. Dim fieldSeparator As Integer
  81. Dim textDelimiter as Integer
  82. Dim charset as Integer
  83. Dim firstLine as Integer
  84. Dim columnFormat as String
  85. Dim languageId as Integer
  86. Dim QuotedfFeldAsText as Boolean
  87. Dim DetectSpecialNumbers as Boolean
  88. Dim SaveCellContentsAsShown as Boolean
  89. Dim filterOptionString as String
  90. Dim fileSuffix as String
  91. Dim saveFilePath as String
  92. Dim saveFileName as String
  93.  
  94.  myDoc   = ThisComponent.CurrentController.Frame
  95.  myDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  96.  mySheets = ThisComponent.getSheets()
  97.  myCurrSheet = mySheets.getByIndex(0)
  98.  startRange = thisComponent.getCurrentSelection.getRangeAddress
  99.  nrRows = startRange.EndColumn
  100.  
  101.  if (nrRows < 2) Then
  102.   MsgBox " apparently, no selection of cells ! "
  103.   stop
  104.  end if
  105.  
  106. ' arrays and variable from cells below table
  107.  splitChar = "_"
  108.  header1 =  myCurrSheet.getCellByPosition(0, 4).String
  109.  header2 =  myCurrSheet.getCellByPosition(0, 5).String
  110.  fileName = myCurrSheet.getCellByPosition(0, 6).String
  111.  header1Array =  split(header1, splitChar)
  112.  header2Array =  split(header2, splitChar)
  113.  
  114.  
  115.  
  116.  ind = 1
  117.  myCell = myCurrSheet.getCellByPosition(0, ind)
  118.  myCellString = myCell.getString()
  119.  
  120.  Do while Len(myCellString) > 1
  121.   ind = ind+1
  122.   myCell = myCurrSheet.getCellByPosition(0, ind)
  123.   myCellString = myCell.getString()
  124.  Loop
  125.  ul_tempTableRowNum = ind + 6
  126.  
  127.  
  128.  charHeight1 = 10
  129.  charHeight2 = 11
  130.  charHeight3 = 12
  131.  charWeight1 = 110
  132.  charWeight2 = 140
  133.  charColor1 =  10
  134.  charColor2 =  11
  135.  columnWidth1 = 5000
  136.  columnWidth2 = 2500
  137.  
  138.  chartHeight = 9000
  139.  chartWidth =  14000
  140.  colorDataserie0 = RGB(115, 230, 115)
  141.  colorDataserie1 = RGB(235, 235, 900)
  142.  colorWall =   RGB(220, 220, 250)
  143.  colorLegend = RGB(150, 150, 220)  
  144.  colorHeaderCells =  RGB(210, 210, 210)
  145.  colorNumberCells  = RGB(250, 250, 200)
  146.  
  147.  for ind = 1 to UBound(header1Array)
  148.   titleString = titleString + header1Array(ind) + " "
  149.  next ind
  150.  titleString = Mid(titleString, 1, Len(titleString) -1 )
  151.  
  152.  for ind = 1 to UBound(header2Array)
  153.   subtitleString = subtitleString + header2Array(ind) + " "
  154.  next ind
  155.  subtitleString = Mid(subtitleString, 1, Len(subtitleString) -1 )
  156.  
  157.  YAxisTitle = header2Array(0)
  158.  
  159.  lr_tempTable_rowNum = ul_tempTableRowNum + nrRows
  160.  ul_tempTablePoint = "$A$" + ul_tempTableRowNum
  161.  ur_tempTablePoint = "$C$" + ul_tempTableRowNum
  162.  
  163. ' adjusting columns, setting background color in cells etc
  164.  numberRange = myCurrSheet.getCellRangeByPosition(startRange.StartColumn + 1, 1, startRange.EndColumn, 2)
  165.  numberRange.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
  166.  numberRange.CellBackColor = colorNumberCells
  167.  
  168.  rangeColumnHeader = myCurrSheet.getCellRangeByPosition(1,  0, startRange.EndColumn , 0)
  169.  rangeColumnHeader.setPropertyValue("CharWeight",  charWeight1)  
  170.  rangeColumnHeader.setPropertyValue("CharHeight",  charHeight2)  'charHeight1)     
  171.  rangeColumnHeader.setPropertyValue("CharColor",   charColor1)  
  172.  rangeColumnHeader.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
  173.  rangeColumnHeader.CellBackColor = colorHeaderCells  
  174.  
  175.  rangeRowHeaders = myCurrSheet.getCellRangeByPosition(startRange.StartColumn,  1, startRange.StartColumn , 2)
  176.  rangeRowHeaders.setPropertyValue("CharWeight",  charWeight2)  
  177.  rangeRowHeaders.setPropertyValue("CharHeight",  charHeight3) ' charHeight2)   
  178.  rangeRowHeaders.setPropertyValue("CharColor",   charColor1)  
  179.  rangeRowHeaders.CellBackColor = colorHeaderCells
  180.  
  181.  myColumns = myCurrSheet.getColumns()
  182.  myColumns.getByIndex(0).width = columnWidth1
  183.  for ind = 1 to nrRows
  184.   myColumns.getByIndex(ind).width =  columnWidth2
  185.  next ind
  186.  
  187.  myRows = myCurrSheet.getRows()
  188.  myRows.OptimalHeight = true
  189.  
  190.  ' copy selected cells and paste with transpose below it
  191.  to_point_args(0).Name = "ToPoint"
  192.  to_point_args(0).Value = startRange
  193.  transpose_args(0).Name = "Flags"
  194.  transpose_args(0).Value = "SV"
  195.  transpose_args(1).Name = "FormulaCommand"
  196.  transpose_args(1).Value = 0
  197.  transpose_args(2).Name = "SkipEmptyCells"
  198.  transpose_args(2).Value = false
  199.  transpose_args(3).Name = "Transpose"
  200.  transpose_args(3).Value = true
  201.  transpose_args(4).Name = "AsLink"
  202.  transpose_args(4).Value = false
  203.  transpose_args(5).Name = "MoveMode"
  204.  transpose_args(5).Value = 4
  205.  myDispatcher.executeDispatch(myDoc, ".uno:GoToCell", "", 0, to_point_args())
  206.  myDispatcher.executeDispatch(myDoc, ".uno:Copy", "", 0, Array())
  207.  to_point_args(0).Value =  ul_tempTablePoint
  208.  myDispatcher.executeDispatch(myDoc, ".uno:GoToCell", "", 0, to_point_args())
  209.  myDispatcher.executeDispatch(myDoc, ".uno:InsertContents", "", 0, transpose_args()
  210.  
  211. ' adjust headers in temp table
  212.  myCell = myCurrSheet.getCellByPosition(1,  ul_tempTableRowNum-1)
  213.  myCell.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
  214.  
  215.  myCell = myCurrSheet.getCellByPosition(2,  ul_tempTableRowNum-1)
  216.  myCell.setPropertyValue("HoriJustify", com.sun.star.table.CellHoriJustify.CENTER)
  217.  
  218. ' todo, not figured out how to make hatch-pattern in staples
  219.  myHatch.Style = com.sun.star.drawing.HatchStyle.SINGLE
  220.  myHatch.Color = RGB(64,64,64)
  221.  myHatch.Distance = 20
  222.  myHatch.Angle = 450
  223.  
  224. ' the chart
  225.  chartVerticalRow = ul_tempTableRowNum -1 + nrRows +6
  226.  chartVerticalPos = chartVerticalRow*450
  227.  myRect.Width = chartWidth
  228.  myRect.Height = chartHeight
  229.  myRect.X = 500
  230.  myRect.Y = chartVerticalPos  '10000
  231.  
  232.  myRangeAddress(0).Sheet = 0  
  233.  myRangeAddress(0).StartColumn = 0
  234.  myRangeAddress(0).StartRow = ul_tempTableRowNum -1
  235.  myRangeAddress(0).EndColumn = 2
  236.  myRangeAddress(0).EndRow =  ul_tempTableRowNum -1 + nrRows
  237.  
  238.  myCharts = myCurrSheet.Charts
  239.  myCharts.addNewByName("chart1", myRect, myRangeAddress(),TRUE, TRUE)
  240.  myCurrChart = myCharts.getByName("chart1").embeddedObject
  241.  
  242.  myCurrChart.Diagram = myCurrChart.createInstance("com.sun.star.chart.BarDiagram")
  243.  myCurrChart.HasMainTitle = True
  244.  myCurrChart.Title.String = titleString  
  245.  myCurrChart.Subtitle.String = subtitleString  
  246.  myCurrChart.Diagram.YAxis.AxisTitle.String = YAxisTitle
  247.  myCurrChart.HasLegend = True
  248.  
  249.  myCurrChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.RIGHT
  250.  myCurrChart.Legend.FillStyle = com.sun.star.drawing.FillStyle.SOLID
  251.  myCurrChart.Legend.FillColor = colorLegend  
  252.  myCurrChart.Legend.CharHeight = charHeight1 ' charHeight0' 10
  253.  
  254.  ' Wall is background to staples, Area is for whole chart
  255.  myCurrChart.Area.FillStyle = com.sun.star.drawing.FillStyle.BITMAP  
  256.  myCurrChart.Area.FillBitmapName = "Marble"    
  257.  myCurrChart.Area.FillBitmapMode = com.sun.star.drawing.BitmapMode.REPEAT
  258.   myCurrChart.Area.FillTransparence = "20%"
  259.  myCurrChart.Area.LineTransparence = "50%"
  260.  
  261.  myCurrChart.Diagram.Wall.FillStyle = com.sun.star.drawing.FillStyle.SOLID
  262.  myCurrChart.Diagram.Wall.FillColor = colorWall
  263.  myCurrChart.Diagram.Wall.FillTransparence = "30%"
  264.  myCurrChart.Diagram.Wall.LineTransparence = "50%"
  265.  
  266.  myDiagram = myCurrChart.getFirstDiagram()
  267.  myCoords = myDiagram.getCoordinateSystems()
  268.  myCurrCoord = myCoords(0)
  269.  myChartTypes = myCurrCoord.getChartTypes()
  270.  myCurrChartType = myChartTypes(0)
  271.  myDataSeries = myCurrChartType.getDataSeries()
  272.  myDataSeries(0).Color = colorDataserie0
  273.  myDataSeries(1).Color = colorDataserie1  
  274.  columnFormat = "1/1"
  275.  for ind = 2 to nrRows
  276.    columnFormat =  columnFormat + "/" + ind + "/10"
  277.  next ind
  278.  
  279. ' saving the file, could also be closed after
  280.  saveFilePath = "file:///C:/Users/ ... /OneDrive/Offentligt/excel/"
  281.  fieldSeparator = 44  ' ","
  282.  textDelimiter =  34  ' """
  283.  charset = 11         ' ASCII/US (Western)
  284.  firstLine = 1
  285.  languageId = 1033 ' English US
  286.  quotedfFeldAsText = false
  287.  DetectSpecialNumbers = false
  288.  saveCellContentsAsShown = true
  289.  fileSuffix = ".xls"
  290.  saveFileName = saveFilePath + fileName + "test1" + fileSuffix
  291.  filterOptionString = "" + fieldSeparator + ", " + textDelimiter + ", " + charset + ", " + firstLine + ", " + columnFormat + ", " + languageId + ", " + quotedfFeldAsText + ", " + DetectSpecialNumbers + ""
  292.  myFileProps(0).Name = "FilterName"
  293.  myFileProps(0).Value = "MS Excel 97"
  294.  myFileProps(1).Name = "FilterOptions"
  295.  myFileProps(1).Value = filterOptionString
  296.  myFileProps(2).Name = "MacroExecutionMode"
  297.  myFileProps(2).Value = 4
  298.  
  299.  on error resume next
  300.  thisComponent.storeToURL(saveFileName, myFileProps)
  301.  'thisComponent.close(true)
  302.  'thisComponent.storeAsURL(saveFileName, myFileProps) ' changing name om document keeping it open
  303. end sub ' makeStapleChart
Advertisement
RAW Paste Data Copied
Advertisement