So I have a macro to clear some cells A2-A250 but I want to return to cell A1 once I have finished
Sub reset
Dim oActiveSheet As Variant
Dim oCellRangeByName As Variant
oActiveSheet = ThisComponent.getCurrentController().getActiveSheet()
oCellRangeByName = oActiveSheet.getCellRangeByName("A1:A250")
oCellRangeByName.clearContents(7)
End Sub
To move to a cell, select it:
oRange = oActiveSheet.getCellRangeByName("A1")
ThisComponent.getCurrentController().Select(oRange)
Section 6.5.3 of Andrew Pitonyak's macro document discusses how to select a cell with or without the outline. Add this code to unhighlight the cell:
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
ThisComponent.getCurrentController().Select(oRanges)
Related
As I can't solve my problem I'd like to ask someone more experienced.I created simple dialog (4 fields) to let the user enter few data. After clicking "Submit" button those data should be inserted into textboxes put ON THE SHEET (not on any dialog). How to refer to those sheet texboxes in code to insert those data? Other thing is deleting those data after clicking other button "Clear". Suppose it will be similar to inserting but how this piece of code should look like?
Thanks in advance.
The trick is to create a com.sun.star.drawing.TextShape object and add it to the Draw Page of the target sheet. The following works for me. You should be able to assign it to the appropriate button on your dialog.
Sub InsertTextBox()
Dim oDocument As Object
oDocument = ThisComponent
If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
Dim sText As String
sText = "Blah,blah, blah!"
Dim oPosition As New com.sun.star.awt.Point
oPosition.X = 1000
oPosition.Y = 1000
Dim oSize As New com.sun.star.awt.Size
oSize.Width = 10000
oSize.Height = 5000
Dim oTextShape As Object
oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape")
oTextShape.setPosition(oPosition)
oTextShape.setSize(oSize)
oTextShape.setPropertyValue("FillStyle", "SOLID")
oTextShape.Visible = 1
' Give it a name so you can find it again when you want to delete it
oTextShape.setPropertyValue("Name", "Thingy")
Dim oDrawPage As Object
oDrawPage = oDocument.getSheets().getByIndex(0).getDrawPage()
oDrawPage.add(oTextShape)
' Set the string of the text shape AFTER adding it to the
' draw page, otherwise the text will not be set.
oTextShape.setString(sText)
End If
End Sub
In the above routine the TextShape object was given the name "Thingy". You can obviously give it any name you like, but it should be unique. To delete it, you need to loop through all the objects in the draw page, find the one that is a TextShape and has the name you gave it (in this case "Thingy") and remove it. This can be done as follows:
Sub DeleteTextBox()
Dim oDocument As Object
oDocument = ThisComponent
If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
Dim oDrawPage As Object
oDrawPage = oDocument.getSheets().getByIndex(0).getDrawPage()
Dim oShape As Object
Dim i As Long
For i = (oDrawPage.getCount() - 1) To 0 Step -1
oShape = oDrawPage.getByIndex(i)
If oShape.SupportsService("com.sun.star.drawing.TextShape") Then
If StrComp(oShape.getPropertyValue("Name"), "Thingy") = 0 Then
oDrawPage.remove(oShape)
End If
End If
Next i
End If
End Sub
This will delete all objects of type TextShape and named "Thingy"
I am trying to create two tables which mirror changes made to any of them to one another automatically.
To that end, I added event listeners which are triggered when the cells of these tables are edited by the user.
Unfortunately, editing one of the tables causes LibreOffice to crash, even though the changes are indeed reflected correctly, as seen upon reopening the file.
I thought the crash might be due to a never-ending circular reference, but it still crashes after it has been made non-circular (by commenting out the relevant parts of the code so that changes are reflected only one way rather than both ways).
I noticed the code worked fine when writing to a cell that didn't have an event listener set to it.
How can I write to one of the cells with event listeners set to them without causing LibreOffice to crash?
You may want to download the following file. Please run Main and then try editing the cell C3 of the Planning sheet. The arbitrary string "C" should be written in the cell C4 of the Services sheet.
Here is a simplified version of the code :
REM ***** BASIC *****
const SERVICESSHEET_NUMBER = 2
const SERVICESSHEET_SERVICES_COLUMN = 2
Type cellStruct
columnNumber As Integer
rowNumber As Integer
End Type
Sub UpdateServicesSheet(editedCell As cellStruct, newValue As String)
Dim oSheets
Dim servicesSheet
oSheets = ThisComponent.getSheets()
servicesSheet = oSheets.getByIndex(SERVICESSHEET_NUMBER)
servicesSheet.getCellByPosition(SERVICESSHEET_SERVICES_COLUMN, 3).setString(newValue)
End Sub
Private oListener, cellRange as Object
Sub AddListener
Dim sheet, cell as Object
sheet = ThisComponent.Sheets.getByIndex(0) 'get leftmost sheet
servicesSheet = ThisComponent.Sheets.getByIndex(2)
cellRange = sheet.getCellrangeByName("C3")
oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
cellRange.addModifyListener(oListener) 'register the listener
cellRange = servicesSheet.getCellrangeByName("C4")
oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
cellRange.addModifyListener(oListener) 'register the listener
End Sub
global CircularReferenceAllowed As boolean
Sub Modify_modified(oEv)
Dim editedCell As cellStruct
Dim newValue As String
editedCell.columnNumber = 2
editedCell.rowNumber = 2
If CircularReferenceAllowed Then
CircularReferenceAllowed = false
UpdateServicesSheet(editedCell, "C")
End If
End Sub
Sub Modify_disposing(oEv)
End Sub
Sub RmvListener
cellRange.removeModifyListener(oListener)
End Sub
Sub Main
CircularReferenceAllowed = true
AddListener
End Sub
Crossposted to :
OpenOffice forums
LibreOffice discourse platform
It seems like the event trigger is within another event's function is causing the crash. In any case, the solution is to remove the listener, then add it back after modifying the other cell.
You do need to global the Listener and the Cell objects to make this work.
This code is simplified to work on C3 and C15 on the first sheet. It would also output some information on C14, which isn't really necessary for your purpose, but I use it to see what's happening. You need to adopt the according to what you need.
global goListener as Object
global goListener2 as Object
global goCellR as Object
global goCellR2 as Object
global goSheet as Object
global giRun as integer
global giUpd as Integer
Sub Modify_modified(oEv)
Dim sCurStr$
Dim sNewStr As String
'xRay oEv
giRun = giRun + 1
sCurStr = oEv.source.string
oCell = goSheet.getCellByPosition(2, 14)
If (oCell.getString() <> sCurStr) Then
' only update if it's different.
giUpd = giUpd + 1
goCellR2.removeModifyListener(goListener2)
oCell.setString(sCurStr)
goCellR2.addModifyListener(goListener2)
End If
sNewStr =sCurStr & " M1 Run=" & giRun & " Upd=" & giUpd
goSheet.getCellByPosition(2, 13).setString(sNewStr)
End Sub
Sub Modify2_modified(oEv)
Dim sCurStr$
Dim sNewStr As String
Dim oCell as Object
'xRay oEv
giRun = giRun + 1
sCurStr = oEv.source.string
oCell = goSheet.getCellByPosition(2, 2)
If (oCell.getString() <> sCurStr) Then
' only update if it's different.
giUpd = giUpd + 1
goCellR.removeModifyListener(goListener)
oCell.setString(sCurStr)
goCellR.addModifyListener(goListener)
End If
sNewStr =sCurStr & " M2 Run=" & giRun & " Upd=" & giUpd
goSheet.getCellByPosition(2, 13).setString(sNewStr)
End Sub
Sub Modify_disposing(oEv)
MsgBox "In Modify_disposing"
End Sub
Sub Modify2_disposing(oEv)
MsgBox "In Modify2_disposing"
End Sub
Sub RmvListener
MsgBox "In RmvListener"
goCellR.removeModifyListener(goListener)
goCellR2.removeModifyListener(goListener2)
End Sub
Sub AddListener
goSheet = ThisComponent.Sheets.getByIndex(0) 'get leftmost goSheet
'servicesSheet = ThisComponent.Sheets.getByIndex(2)
goCellR = goSheet.getCellrangeByName("C3")
goListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
goCellR.addModifyListener(goListener) 'register the listener
goCellR2 = goSheet.getCellrangeByName("C15")
goListener2 = createUnoListener("Modify2_","com.sun.star.util.XModifyListener") 'create a listener
goCellR2.addModifyListener(goListener2) 'register the listener
End Sub
Sub Main
giRun = 0
giUpd = 0
AddListener
End Sub
I'm writing a macro with libreoffice basic to modify the styles and size of a selected (and only selected) chart in my spreadsheets.
After many documentation reading and many tries, I managed to have a partial solution to my problem:
Modifying all charts style
I managed to select a chart by it's indexe and modify it's styles with this macro:
Sub ModifyChart
Dim oDoc As Object
Dim oChart As Object
Dim aSize as new com.sun.star.awt.Size
oSheet = ThisComponent.sheets(0)
oCharts = oSheet.getCharts()
oChart = oCharts.getByIndex(0).getEmbeddedObject()
MsgBox oChart.ImplementationName
oChart.Title.String = "My title"
oChart.Title.CharColor = RGB(0,0,200)
oChart.Title.CharFontName = "Arial"
oChart.Title.CharHeight = 16
oChart.SubTitle.String = "My subtitle"
oChart.SubTitle.CharColor = RGB(0,0,200)
oChart.SubTitle.CharFontName = "Arial"
oChart.SubTitle.CharHeight = 12
oChart.Diagram.Wall.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oChart.Diagram.Wall.FillColor = RGB(200,50,150)
oChart.Area.FillStyle = com.sun.star.drawing.FillStyle.SOLID
oChart.Area.FillColor = RGB(100,50,250)
aSize.Width=640
aSize.Height=400
oChart.setsize(aSize) ' Error occur at this point
End Sub
Problem: It's doesn't work with the selected chart and I can't resize it. The method setsize doesn't work for this kind of object. I tryed to get the parent object of the chart ( frame ? or shape ?) without success.
With ImplementationName, I found that the object is a com.sun.star.comp.sc.scshapeobj
Modifying the selected chart size
I managed to modify the selected chart size by using this macro
Sub ResizeChart
Dim oCurrSel As Object
Dim oItem As Object
Dim aSize As New com.sun.star.awt.Size
oCurrSel = ThisComponent.getCurrentSelection()
oItem = oCurrSel.getByIndex(0)
MsgBox oItem.ImplementationName
aSize.width=16000
aSize.height=12000
oItem.setsize(aSize)
End Sub
Problem: I can't access to the other styles of the chart. I tryed to find a method to get the object content without success. I also tryed to investigate the object with oItem.dbg_properties and oItem.dbg_methods but I didn't found anything useful.
With ImplementationName, I found that the object is a com.sun.star.comp.chart2.chartmodel
I have a look to the libreoffice api but I didn't find how these two kind of object are connected.
Is it possible to make what I want with libreoffice basic ?
Does anyone could explain me the hierachical structure of a libreoffice chart object (parents, childs, ...) and how to deal with it ?
Yes, you are absolutely right - parsing the current selection is not a trivial task.
Since the current selection may contain a variety of objects - Cell, CellRange, SheetCellRanges, Shapes, ShapeCollection, GraphicObjectShape and even in some cases just Text, parsing becomes similar to the game "Miner" - each next step requires additional checks (or error handling " blindly "with the help On Error Resume Next)
Your idea of using ImplementationName to identify objects is generally good. But Andrew Pitonyak in 4.1. Debugging And Inspecting Macros wrote "To determine the document type, look at the services it supports ... I assume that this is safer than using getImplementationName()" and I tend to believe him.
The transition from the current selection to the embedded chart can be something like this:
Sub ModifyChartInCurrentSelection
Dim oCurrentSelection As Variant
Dim i As Long
Dim oNextElementOfSelection As Variant
Dim oEmbeddedObject As Variant
Dim oComponent As Variant
Dim aSize As New com.sun.star.awt.Size
oCurrentSelection = ThisComponent.getCurrentSelection()
If oCurrentSelection.supportsService("com.sun.star.drawing.ShapeCollection") Then
For i = 0 To oCurrentSelection.getCount()-1
oNextElementOfSelection = oCurrentSelection.getByIndex(i)
If oNextElementOfSelection.supportsService("com.sun.star.drawing.OLE2Shape") Then
Rem Size of shape (outer wrapper around the chart)
If oNextElementOfSelection.supportsService("com.sun.star.drawing.Shape") Then
aSize = oNextElementOfSelection.getSize()
aSize.Height = aSize.Height * 2 ' or any other
aSize.Width = aSize.Width / 2
oNextElementOfSelection.setSize(aSize)
EndIf
Rem Properties of EmbeddedObject
oEmbeddedObject = oNextElementOfSelection.EmbeddedObject
If Not IsEmpty(oEmbeddedObject) Then
oComponent = oEmbeddedObject.getComponent()
oComponent.getTitle().String = "Foo-bar Foo-bar Foo-bar"
Rem and other settings...
EndIf
EndIf
Next i
EndIf
End Sub
I want to create a {1,2} cell array, that will contain single cell value in {1,1} and several cells in {1,2}{:,1} row:
TEXT = {'-1';'432';'a';'c';'v';'-1';'-1';'14';'b';'n';'-1';'-1';'44';'m';'t';'r';'-1';'-1';'55';'o';'i';'u';'-1'};
Sections{1,1} = TEXT{5};
Sections{1,2}{:,1} = TEXT{3:10,1};
,but I get an ERROR:
The left hand side is initialized and has an empty range of indices.
However, the right hand side returned one or more results.
Error in fff (line 4)
Sections{1,2}{:,1} = TEXT{3:10,1}; % Text in the section
Ideas?
Just use () instead of {} for the sections in (n,2):
TEXT = {'-1';'432';'a';'c';'v';'-1';'-1';'14';'b';'n';'-1';'-1';'44';'m';'t';'r';'-1';'-1';'55';'o';'i';'u';'-1'};
Sections{1,1} = TEXT{5};
Sections{1,2} = TEXT(3:10,1);
If i want to get value all of row in table and I want to set it in array . How I shound do ?
Please advice me , Thanks a lot .
Sub Cut 'This method is cut value from user selectio and set to Copy variable.
Selection = ThisComponent.getCurrentSelection()
End Sub
It is not really clear what you are asking about. But if the goal is to get the DataArray from selected cells, then the following should do that:
Sub getArrayFromSelection
oSelection = ThisComponent.getCurrentSelection()
if oSelection.supportsService("com.sun.star.sheet.SheetCellRange") then
aDataArray = oSelection.getDataArray()
lRows = ubound(aDataArray)
lCols = ubound(aDataArray(0))
for lRow = 0 to lRows
for lCol = 0 to lCols
msgbox aDataArray(lRow)(lCol)
next
next
end if
End Sub