[Solved] Can't remove chart using macro

[skrat]

I followed topic viewtopic.php?f=44&t=55115 and changed my macro to locate sheets by their name and not by their index value.

Code: Select all

REM  *****  BASIC  *****
Option Explicit

Sub Main
	Dim SheetName As String
	
	SheetName = "Cell"
	
	GenerateChart(SheetName,0,"com.sun.star.chart.XYDiagram")
End Sub

Sub removeChart(ChartName As String, SheetName as String)
	Dim oDoc As Object, oSheet As Object, oShapes As Object, oShape As Object
	Dim i As Integer
	
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName(SheetName)
	oShapes = oSheet.DrawPage
	i = 0
	do while i < oShapes.getCount()
		oShape = oShapes(i)
		if oShape.Name = ChartName then
			oShapes.remove(oShape)
			exit do
		endif
		i = i + 1
	loop
	
End Sub


Sub GenerateChart(SheetName as string, ChartNo as integer, ChartType As String)
	Dim oDoc As Object, oSheet As Object, Charts As Object, Chart As Object, oChartDoc As Object, oChart As Object
	Dim Rect As new com.sun.star.awt.Rectangle
	Dim RangeAddress(0) As New com.sun.star.table.CellRangeAddress
	Dim oData As Object
  	Dim oDataArray( 0 To 1000,0 To 1)
  	Dim oFirstDiagram As Object, oDiagram As Object
  	Dim oCoords
  	Dim oCoord
  	Dim oChartTypes
  	Dim oChartType
  	Dim oDataSeries
  	Dim oSeries
  	Dim oSymbol
  	Dim oDesc
  	Dim oxAxis, oyAxis
  	Dim x As Double
  	Dim i As Long
  	
  	for i = 0 to 1000
  		if i <> 0 then
  			x = 2 * pi * i / 1000
  		else
  			x = 0
  		endif
  		
  		oDataArray( i, 0) = x
  		oDataArray( i, 1) = Sin(x)
  	next i
 	
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName(SheetName)
	charts= oSheet.Charts
	
	'Position and dimension
  	with Rect
    	.Width = 25000
    	.Height = 12500
    	.X = 100
    	.Y = 500 
  	end with

  	with RangeAddress(0)
    	.Sheet = oSheet.RangeAddress.Sheet
    	.StartRow = 0 
    	.StartColumn = 0
      	.EndRow = 0 
  	end with
  	
 	removeChart("chart" & ChartNo, SheetName) ' Delete chart if present
  	charts.addNewByName("chart" & ChartNo, Rect ,RangeAddress(), false, false)
  	oChart = oSheet.Charts.getByName( "chart" & ChartNo )
  	oChartDoc = oChart.getEmbeddedObject()

  	'Change to ChartType
  	with oChartDoc
    	.createInstance(ChartType)
  	end with
 	
 	ClearChart(oChart)
 	
 	oData = oChartDoc.getData()
 	
  ' call setData() method of XChartDataArray to apply the data
  	oData.setData(oDataArray())
  	
  	oDesc = oChartDoc.Data.ColumnDescriptions
  	oDesc(0) = "Sin x"
  	oDesc(1) = "Sin x"
  	oChartDoc.Data.ColumnDescriptions = oDesc
  	oDesc = oChartDoc.Data.ComplexColumnDescriptions
  	oDesc(0)(0) = "Sin x"
  	oDesc(1)(0) = "Sin x"
  	oChartDoc.Data.ComplexColumnDescriptions = oDesc
  	oFirstDiagram = oChartDoc.getFirstDiagram()
  	oDiagram = oChartDoc.getDiagram()
  ' get coordinates from the diagram
  	oCoords = oFirstDiagram.getCoordinateSystems()
  	oCoord = oCoords(0)

  ' get chart type
  	oChartTypes = oCoord.getChartTypes()
  	oChartType = oChartTypes(0)
  	oDataSeries = oChartType.getDataSeries()
  	oSeries = oDataSeries(0)
  	oSymbol = oSeries.Symbol
  	oSymbol.Style = 0
  	oSeries.Symbol = oSymbol
  	oSeries.LineWidth = 1
  	oChartDoc.hasMainTitle = True
  	oChartDoc.Title.String = "Sine x"
  	oChartDoc.Title.CharWeight = com.sun.star.awt.FontWeight.BOLD
  	oChartDoc.Title.CharHeight = 20
  	oChartDoc.Title.CharFontName = "Times New Roman"
  	oChartDoc.hasSubTitle = True
  	oChartDoc.SubTitle.String = "0 to 2" & Chr(960)
  	oChartDoc.SubTitle.CharFontName = "Times New Roman"
  	oxAxis = oDiagram.XAxis
  	oxAxis.NumberFormat = getFormat("0.00")
  	oxAxis.AxisTitle.String = "x"
  	oxAxis.CrossoverPosition = com.sun.star.chart.ChartAxisPosition.ZERO
  	oyAxis = oDiagram.yAxis
  	oyAxis.NumberFormat = getFormat("0.00")
  	oyAxis.AxisTitle.String = "y"
  	  	
End Sub

Sub ClearChart(Chart As Object)

	Dim Doc As Object
	Dim Sheet As Object
	Dim ChartSheet As Object
	Dim SetupSheet As Object
	Dim oChart
	Dim oFirstDiagram
	Dim oDataSeries
	Dim oCoords
	Dim oCoord
	Dim oChartTypes
	Dim oChartType
	Dim i As Long
	
	Doc = ThisComponent
		
	oChart = Chart.getEmbeddedObject()
	oFirstDiagram = oChart.getFirstDiagram()
  	
  ' get coordinates from the diagram
  	oCoords = oFirstDiagram.getCoordinateSystems()
  	oCoord = oCoords(0)

  ' get chart type
  	oChartTypes = oCoord.getChartTypes()
  	oChartType = oChartTypes(0)
  	
  	oDataSeries = oChartType.getDataSeries()
  	i = UBound(oDataSeries)
  	  	
  	do while i >= 0 
  		oChartType.removeDataSeries(oDataSeries(i))
  		i = i - 1
  	loop
  	
End Sub

Function getformat(f As String) As Long
   Dim oDoc As Object
   Dim NumberFormats As Object
   Dim Loc as New com.sun.star.lang.Locale
   Dim formatID As Long
      
   oDoc = ThisComponent
         
   Loc.Language = "en"
   Loc.Country = "US"
   
   NumberFormats = oDoc.NumberFormats
   
   formatId = NumberFormats.queryKey(f, Loc, False)
   If formatId = -1 Then
      formatId = NumberFormats.addNew(f, Loc)
   End If
   
   getformat  = formatID
   
End Function

But as a result my "removeChart" stopped working. It goes to error saying:
BASIC runtime error. An Exception occured Type: com.sun.star.uni.RuntimeExceptionMessage: .
with the following line highlighted:
charts.addNewByName("chart" & ChartNo, Rect ,RangeAddress(), false, false)

anybody has an idea what the problem is?

[skrat]

I would really need this.

I would really like it if I could generate a chart on mouse press. But this "Removechart" function for some unknown reason isn't working as it should...

[Zizi64]

But as a result my "removeChart" stopped working. It goes to error saying:
BASIC runtime error. An Exception occured Type: com.sun.star.uni.RuntimeExceptionMessage: .
with the following line highlighted:
charts.addNewByName("chart" & ChartNo, Rect ,RangeAddress(), false, false)

That line is not located inside the Sub "removeChart", but it is in the Sub "GenerateChart".


Just a tip:
Check the objects by the usage of the MRI, or the XrayTool. Check the passed parameters by a temporary Print or MsgBox command in your code.

[skrat]

Hmmm... The same error is raised with this code (if run more than once):

Code: Select all

Sub Main
Dim Doc As Object
Dim GraphSheet As Object
Dim Sheets as Object
Dim Charts As Object
Dim Chart as Object
Dim Rect As New com.sun.star.awt.Rectangle
Dim RangeAddress(0) As New com.sun.star.table.CellRangeAddress
Doc = ThisComponent

'Delete and re-add the Graphs sheet to clear it. Probably a better way. 
If Doc.Sheets.hasByName("Graphs") Then
Doc.Sheets.removeByName("Graphs")	
end if

GraphSheet = Doc.createInstance("com.sun.star.sheet.Spreadsheet")
Doc.Sheets.insertByName("Graphs", GraphSheet)
'	Charts = Doc.Sheets(0).Charts	'<- 0 is probably the culprit
'	Charts = Doc.Sheets("Graphs").Charts	'<- Nope, no dif. Graph is written into Data sheet.
Charts = Doc.Sheets(2).Charts	'<- Nope, no dif. Graph is written into Data sheet.

Rect.X = 8000
Rect.Y = 1000
Rect.Width = 10000
Rect.Height = 7000
RangeAddress(0).Sheet = 1
RangeAddress(0).StartColumn = 0
RangeAddress(0).StartRow = 0
RangeAddress(0).EndColumn = 2
RangeAddress(0).EndRow = 12
' Where is this chart displayed? Data!
Charts.addNewByName("MyChart", Rect, RangeAddress(), True, True)	
End Sub

With (again) the last line highlighted...
Charts.addNewByName("MyChart", Rect, RangeAddress(), True, True)

[Zizi64]

Please upload your ODF type sample file with the embedded full macro code.

[Zizi64]

Here is my working sample (works in my LibreOffice 4.4.7):

graph_macro.ods

(11.19 KiB) Downloaded 112 times

[skrat]

Attached is my file. You can check that on first mouse press everything is OK. On second, an error is raised. If you Manually delete the chart before the second press, everything is ok!

Note that I don't want to either create or delete the whole sheet. The sheet where I need the graph also contains other important information. It is also important to me, to define sheet by name, not by index.

[Zizi64]

The difference:

The macro in my sample deletes the Sheet of the graph.

The macro in your sample will try to delete a Shape - recognised by its name. Test the names by a Print command in your sub "removeChart":

Code: Select all

Sub removeChart(ChartName As String, SheetName as String)
   Dim oDoc As Object, oSheet As Object, oShapes As Object, oShape As Object
   Dim i As Integer
   
   oDoc = ThisComponent
   oSheet = oDoc.Sheets.getByName(SheetName)
   oShapes = oSheet.DrawPage
   i = 0
   do while i < oShapes.getCount()
      oShape = oShapes(i)     

'Here is a test line:
      Print "i= ", i, "oShape.name= ", oShape.Name, "ChartName = ", ChartName

      if oShape.Name = ChartName then
          oShapes.remove(oShape)
         exit do
      endif
      i = i + 1
   loop
   
End Sub

[skrat]

Looks to me like "oShape.Name" is blank, therefore

Code: Select all

      if oShape.Name = ChartName then
          oShapes.remove(oShape)
         exit do
      endif

is never really executed. I'm not so sure how to change that...

[Zizi64]

Try this removing procedure:

Code: Select all

Sub removeChart(ChartName As String, SheetName as String)

 Dim oDoc As Object
 Dim oSheet As Object
 Dim oCharts as object 
 Dim oChart as object
 Dim i as integer
   
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName(SheetName)
	oCharts = oSheet.Charts
	If oCharts.Count <> 0 then
		For i = 0 to oCharts.Count-1
			oChart = oCharts.getByIndex(i)
			If oChart.name = ChartName then 
				oCharts.removeByName(ChartName)
			end if
		Next i
	end if   
End Sub

[skrat]

Absolutely awesome!

Works.

[Lupp]

The chart and the shape it is embedded in aren't the same object. If a shape has an embedded chart, you can get the chart's .Name as the shape's .PersistName.. If you want to assign the name of the chart also to the shape after insertion, you need to identify the shape (should be theSheet.DrawPage(theSheet.DrawPage.Count -1) immediately after insertion), you can use theShape.Name = theShape.PersistName. The code below inserted at the top of the BASIC module in your demo example should show this (first run only, of course).

Code: Select all

Sub Test
Dim tC As Object, tS As Object
tC=ThisComponent.Sheets(0).Charts(0)
MsgBox("ChartName= " & tC.Name)
tS=ThisComponent.Sheets(0).DrawPage(1)
MsgBox("Shape.Name= " & tS.Name)
MsgBox("Shape.PersistName= " & tS.PersistName)
tS.Name=tS.PersistName
MsgBox("ShapeName= " & tS.Name)
End Sub