I have a simulation set up in OpenOffice. I want to display the results of the simulation, for say 100 replications, but I can't seem to work out how to do it. Obviously if you just copy the result to a cell and drag it down 100 rows, they all show the same figure.
Either a macro is necessary or there is a built in way. Neither of which I know.
Basically, the equivalent to http://www.youtube.com/watch?v=tpIhQuxQeNs
I created a macro as so:
Sub PasteSpecialNoFormula
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "SelectedFormat"
args3(0).Value = 1
Dim document As Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = ThisComponent
oSheet1 = oDocument.Sheets.getByIndex(0)
oSheet2 = oDocument.Sheets.getByIndex(0)
Dim i As Long, n As Long
n = 1000
for i = 1 to n
oFromRange = oSheet1.getCellRangeByName("B464:C464")
oToCell = oSheet2.getCellByPosition(1,466+i)
oDocument.CurrentController.Select(oFromRange)
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
oDocument.CurrentController.Select(oToCell)
dispatcher.executeDispatch(document, ".uno:ClipboardFormatItems", "", 0, args3())
next i
End Sub
Related
I am writing a macro to generate pie chart in OpenOffice Basic and I want to display the percentage of the different parts on the graph. For example, I want a result as in the following link:
https://learn.microsoft.com/en-us/sql/reporting-services/report-design/display-percentage-values-on-a-pie-chart-report-builder-and-ssrs
Here is my reproducible code:
my data are:
https://i.stack.imgur.com/hwdDz.png
And the Macro:
Sub Macro1
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
oRange = thisComponent.getCurrentSelection.getRangeAddress
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByIndex(0)
oCharts = oSheet.Charts
oRect.Width = 10000
oRect.Height = 10000
oRect.X = 8000
oRect.Y = 1000
oRangeAddress(0).Sheet = oRange.Sheet
oRangeAddress(0).StartColumn = 0
oRangeAddress(0).StartRow = 0
oRangeAddress(0).EndColumn = 1
oRangeAddress(0).EndRow = 2
cTitle = "Test Results"
oCharts.addNewByName(cTitle,oRect,oRangeAddress(),TRUE, TRUE)
oChart = oCharts.getByName(cTitle).embeddedObject
oChart.Diagram = oChart.createInstance("com.sun.star.chart.PieDiagram")
oChart.HasMainTitle = True
oChart.Title.String = cTitle
End Sub
Thank you a lot for your help! I find the documentation for OOo basic very difficult to understand and rather poor.
Starting from https://forum.openoffice.org/en/forum/viewtopic.php?t=44377, I eventually came up with this code that does what you need.
rowProps = oChart.Diagram.getDataRowProperties(0)
rowProps.DataCaption = com.sun.star.chart.ChartDataCaption.PERCENT
Dim oLocale As New com.sun.star.lang.Locale
rowProps.PercentageNumberFormat = ThisComponent.getNumberFormats().queryKey(_
"0%", oLocale, True)
Documentation on number formats, such as there is, can be found at https://wiki.openoffice.org/wiki/Documentation/DevGuide/OfficeDev/Managing_Number_Formats. Many common tasks in Basic are pretty well documented, but what you are doing is somewhat unusual, hence the rather obscure documentation.
Feel free to keep asking for help -- your questions have been well written. With practice, working with the UNO API becomes easier.
I am writing a macro to generate pie chart in OpenOffice Basic but I can't find the method to change the colour of the different part of the pie.
We can take as example the macro of this subject:
OpenOffice Calc macro to add pie chart
That is, my data are:
And my code:
Sub Macro1
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
oRange = thisComponent.getCurrentSelection.getRangeAddress
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByIndex(0)
oCharts = oSheet.Charts
oRect.Width = 10000
oRect.Height = 10000
oRect.X = 8000
oRect.Y = 1000
oRangeAddress(0).Sheet = oRange.Sheet
oRangeAddress(0).StartColumn = 0
oRangeAddress(0).StartRow = 0
oRangeAddress(0).EndColumn = 1
oRangeAddress(0).EndRow = 2
cTitle = "Test Results"
oCharts.addNewByName(cTitle,oRect,oRangeAddress(),TRUE, TRUE)
oChart = oCharts.getByName(cTitle).embeddedObject
oChart.Diagram = oChart.createInstance("com.sun.star.chart.PieDiagram")
oChart.HasMainTitle = True
oChart.Title.String = cTitle
End Sub
How can I get some green in my chart, instead of blue, for example?
Thank you for your help.
Here is one solution.
Sub Macro1
...
oFirstDiagram = oChart.getFirstDiagram()
oColorScheme = CreateUnoListener("XColorScheme_", "com.sun.star.chart2.XColorScheme")
oFirstDiagram.setDefaultColorScheme(oColorScheme)
End Sub
Function XColorScheme_getColorByIndex(index As Integer) As Long
Dim result As Long
result = &H0000FF ' blue
If index = 0 Then
result = &H00FF00 ' green
ElseIf index = 1 Then
result = &HFFFF00 ' yellow
End If
XColorScheme_getColorByIndex = result
End Function
The only relevant documentation I could find for this approach is the API docs: https://www.openoffice.org/api/docs/common/ref/com/sun/star/chart2/XDiagram.html.
Another way is to put the colors in column C.
Status Count Color
Unfinished 20 =COLOR(0,255,0)
Finished 30 =COLOR(255,0,0)
Then set the Range for Fill Color to use column C. If you want to see code for this second approach, post a comment and I'll look into it.
Yet another way is from https://forum.openoffice.org/en/forum/viewtopic.php?t=36001.
oChart.Diagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
oChart.FirstDiagram.CoordinateSystems(0).ChartTypes(0).DataSeries(0).Color = &H00FF00
However, this last approach did not change the color when I tried it.
I have a Libre Office Macro and I need to crop an image, but I have been unable to find any helpful documentation or an example. Anyone have a tip how to do it?
dim noArgs()
dim emptyDocComponent as object
dim document as object
dim dispatcher as object
emptyDocComponent = StarDesktop.LoadComponentFromUrl("private:factory/swriter", "_blank", 0, noArgs())
frame = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(3) as new com.sun.star.beans.PropertyValue
args1(0).Name = "FileName"
args1(0).Value = "file://" & inputPath
args1(1).Name = "FilterName"
args1(1).Value = "<All formats>"
args1(2).Name = "AsLink"
args1(2).Value = false
args1(3).Name = "Style"
args1(3).Value = "Graphics"
dispatcher.executeDispatch(frame, ".uno:InsertGraphic", "", 0, args1())
selection = ThisComponent.CurrentSelection
If selection.ImplementationName <> "SwXTextGraphicObject" Then
Exit Sub
End If
' this is what the macro recorder captured, but it was "rem" and non-functional
rem dispatcher.executeDispatch(document, ".uno:Crop", "", 0, Array())
*** edit
Here is what I am now using in case it helps someone else. I had a picture with a known size in pixels that needed to be cropped. Not entirely sure the calculation is completely accurate, but it is working so far.
dim noArgs()
dim emptyDocComponent as object
dim document as object
dim dispatcher as object
emptyDocComponent = StarDesktop.LoadComponentFromUrl("private:factory/swriter", "_blank", 0, noArgs())
frame = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(3) as new com.sun.star.beans.PropertyValue
args1(0).Name = "FileName"
args1(0).Value = "file://" & inputPath
args1(1).Name = "FilterName"
args1(1).Value = "<All formats>"
args1(2).Name = "AsLink"
args1(2).Value = false
args1(3).Name = "Style"
args1(3).Value = "Graphics"
dispatcher.executeDispatch(frame, ".uno:InsertGraphic", "", 0, args1())
selection = ThisComponent.CurrentSelection
If selection.ImplementationName <> "SwXTextGraphicObject" Then
Exit Sub
End If
' size = (pixels / pixelsPerInch) * mm/in * scaling * actual graphic / displayed graphic
imageWidth = (int(pixelWidth) / int(xPixelsPerInch)) * 25.4 * 110 * (selection.actualSize.Width / selection.Width)
imageHeight = (int(pixelHeight) / int(yPixelsPerInch)) * 25.4 * 110 * (selection.actualSize.Height / selection.Height)
GraphicCrop = selection.GraphicCrop
GraphicCrop.Top = selection.actualSize.Height - imageHeight
GraphicCrop.Bottom = 0
GraphicCrop.Left = 0
GraphicCrop.Right = selection.actualSize.Width - imageWidth
selection.GraphicCrop = GraphicCrop
TextGraphicObject has a struct called GraphicCrop.
The following code was adapted from https://forum.openoffice.org/en/forum/viewtopic.php?f=25&t=72496.
selection = ThisComponent.CurrentSelection
If selection.ImplementationName <> "SwXTextGraphicObject" Then
Exit Sub
End If
pxPerInch = 100*25.6
cropFig = selection.GraphicCrop
cropFig.Left = 0.27*pxPerInch
cropFig.Right = 1.34*pxPerInch
cropFig.Top = 0.31*pxPerInch
cropFig.Bottom = 0.18*pxPerInch
selection.GraphicCrop = cropFig
Search the net for "DannyB" (in combination with OpenOffice) to find his very useful libraries on StarBasic macros for the Drawcomponent.
I'm pretty sure he has an example.
Other resource to look into: Andrew Pitonyak's "OpenOffice Macros Explained", might have an example as well.
In LibreOffice Basic sub I use a bunch of uno properties in an array. Which is the simplest Unostructure or UnoService that I must "embed" them, in order to use the getByName "function"?
Example:
dim props(1) as new com.sun.star.beans.PropertyValue
props(0).Name = "blahblah1"
props(0).Value = "blahblah1Value"
props(1).Name = "blahblah2"
props(1).Name = 3000
I want to be able to use something like:
b = props.getByName("blahblah2").Value
or something like (assuming I "assigned" them in a structure-like-object called "somestruct") :
b = somestruct.getprops.getByName("blahblah2").Value
As I understand that this can be done by creating a "UnoService" which supports the getByName and then, somehow, assigning these props to this service
Which is the "lightest" such service?
(I mean the service that uses less resources)
Thanks in advance.
Really supporting the interface XNameAccess is not as easy. The services which implement this interface are supposed using this interface for existing named properties, not for own created ones.
But you can use the service EnumerableMap to achieve what you probably want.
Example:
sub testEnumerableMap
serviceEnumerableMap = com.sun.star.container.EnumerableMap
oEnumerableMap = serviceEnumerableMap.create("string", "any")
oEnumerableMap.put("blahblah1", "blahblah1Value")
oEnumerableMap.put("blahblah2", 3000)
oEnumerableMap.put("blahblah3", 1234.67)
msgbox oEnumerableMap.get("blahblah1")
msgbox oEnumerableMap.get("blahblah2")
msgbox oEnumerableMap.get("blahblah3")
'msgbox oEnumerableMap.get("blahblah4") 'will throw error
msgbox oEnumerableMap.containsKey("blahblah2")
msgbox oEnumerableMap.containsValue(3000)
if oEnumerableMap.containsKey("blahblah4") then
msgbox oEnumerableMap.get("blahblah4")
end if
end sub
But starbasic with option Compatible is also able supporting Class programming like VBA does.
Example:
Create a module named myPropertySet. Therein put the following code:
option Compatible
option ClassModule
private aPropertyValues() as com.sun.star.beans.PropertyValue
public sub setProperty(oProp as com.sun.star.beans.PropertyValue)
bUpdated = false
for each oPropPresent in aPropertyValues
if oPropPresent.Name = oProp.Name then
oPropPresent.Value = oProp.Value
bUpdated = true
exit for
end if
next
if not bUpdated then
iIndex = ubound(aPropertyValues) + 1
redim preserve aPropertyValues(iIndex)
aPropertyValues(iIndex) = oProp
end if
end sub
public function getPropertyValue(sName as string) as variant
getPropertyValue = "N/A"
for each oProp in aPropertyValues
if oProp.Name = sName then
getPropertyValue = oProp.Value
exit for
end if
next
end function
Then within a standard module:
sub testClass
oPropertySet = new myPropertySet
dim prop as new com.sun.star.beans.PropertyValue
prop.Name = "blahblah1"
prop.Value = "blahblah1Value"
oPropertySet.setProperty(prop)
prop.Name = "blahblah2"
prop.Value = 3000
oPropertySet.setProperty(prop)
prop.Name = "blahblah3"
prop.Value = 1234.56
oPropertySet.setProperty(prop)
prop.Name = "blahblah2"
prop.Value = 8888
oPropertySet.setProperty(prop)
msgbox oPropertySet.getPropertyValue("blahblah1")
msgbox oPropertySet.getPropertyValue("blahblah2")
msgbox oPropertySet.getPropertyValue("blahblah3")
msgbox oPropertySet.getPropertyValue("blahblah4")
end sub
LibreOffice Basic supports the vb6 Collection type.
Dim coll As New Collection
coll.Add("blahblah1Value", "blahblah1")
coll.Add(3000, "blahblah2")
MsgBox(coll("blahblah1"))
Arrays of property values are the only thing that will work for certain UNO interfaces such as dispatcher calls. If you simply need a better way to deal with arrays of property values, then use a helper function.
Sub DisplayMyPropertyValue
Dim props(0 To 1) As New com.sun.star.beans.PropertyValue
props(0).Name = "blahblah1"
props(0).Value = "blahblah1Value"
props(1).Name = "blahblah2"
props(1).Name = 3000
MsgBox(GetPropertyByName(props, "blahblah1"))
End Sub
Function GetPropertyByName(props As Array, propname As String)
For Each prop In props
If prop.Name = propname Then
GetPropertyByName = prop.Value
Exit Function
End If
Next
GetPropertyByName = ""
End Function
XNameAccess is used for UNO containers such as Calc sheets. Normally these containers are obtained from the UNO interface, not created.
oSheet = ThisComponent.Sheets.getByName("Sheet1")
May UNO objects support the XPropertySet interface. Normally these are also obtained from the UNO interface, not created.
paraStyleName = cellcursor.getPropertyValue("ParaStyleName")
It may be possible to create a new class in Java that implements XPropertySet. However, Basic uses helper functions instead of class methods.
I think the serviceEnumerableMap is the answer (so far). Creating the values and searching them was much faster then creating props in a dynamic array and searching them with a for loop in basic.
(I do not "dare" to use "option Compatible", although I was a big fun of VB6 and VBA, because of the problems in code that maybe arise).
I used this code to test time in a form:
SUB testlala(Event)
TESTPROPS(Event)
' TESTENUM(Event)
MSGBOX "END OF TEST"
END SUB
SUB TESTENUM(Event)
DIM xcounter AS LONG
'b = now()
serviceEnumerableMap = com.sun.star.container.EnumerableMap
oEnumerableMap = serviceEnumerableMap.create("string", "any")
FOR xcounter= 0 TO 10000
oEnumerableMap.put("pr" & FORMAT(xcounter,"0000"), xcounter -10000)
NEXT
'b=now()-b
b = now()
FOR xcounter = 1 TO 5000
lala = Int((9000 * Rnd) +1)
g =oEnumerableMap.get("pr" & FORMAT(lala,"0000"))
'MSGBOX GetValueFromName(props,"pr" & FORMAT(xcounter,"0000"))
NEXT
b=now()-b
MSGBOX b*100000
END SUB
SUB TESTPROPS(Event)
DIM props()
DIM xcounter AS LONG
'b = now()
FOR xcounter= 0 TO 10000
AppendProperty(props,"pr" & FORMAT(xcounter,"0000"), xcounter -10000)
NEXT
'b=now()-b
b = now()
FOR xcounter = 1 TO 5000
lala = Int((9000 * Rnd) +1)
g = GetValueFromName(props,"pr" & FORMAT(lala,"0000"))
'MSGBOX GetValueFromName(props,"pr" & FORMAT(xcounter,"0000"))
NEXT
b=now()-b
MSGBOX b*100000
END SUB
REM FROM Andrew Pitonyak's OpenOffice Macro Information ------------------
Sub AppendToArray(oData(), ByVal x)
Dim iUB As Integer 'The upper bound of the array.
Dim iLB As Integer 'The lower bound of the array.
iUB = UBound(oData()) + 1
iLB = LBound(oData())
ReDim Preserve oData(iLB To iUB)
oData(iUB) = x
End Sub
Function CreateProperty(sName$, oValue) As com.sun.star.beans.PropertyValue
Dim oProperty As New com.sun.star.beans.PropertyValue
oProperty.Name = sName
oProperty.Value = oValue
CreateProperty() = oProperty
End Function
Sub AppendProperty(oProperties(), sName As String, ByVal oValue)
AppendToArray(oProperties(), CreateProperty(sName, oValue))
End Sub
This one has me stumped. I am populating a Listbox with a range and then formatting column 4 as d/mm/yyyy. This works fine if all cells in column 4 have a date. As some cells that are populated into the Listbox are in fact blank the sub crashes when it hits these cells. I have tried various if and else statements to skip the activecell if blank with no luck.
Grateful for any assistance.
Alex V
Sub populate_listbox_1()
Dim I As Long
Dim I2 As Long
Dim list_count As Long
Dim MyData As Range
Dim r As Long
With edit_report_input.compliments_listbox
.ColumnCount = 17
.ColumnWidths = "70;300;75;90;80;80;100;0;0;0;0;0;0;0;0;20;0"
.RowSource = ""
Set MyData = ActiveSheet.Range("A4:Q498") 'Adjust the range accordingly
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 1) = "" Then
.RemoveItem r
End If
Next r
End With
For I = 0 To edit_report_input.compliments_listbox.ListCount - 1
edit_report_input.compliments_listbox.List(I, 4) = Format(DateValue(edit_report_input.compliments_listbox.List(I, 4)), "d/mm/yyyy")
Next I
date_rec_compliment = Format(date_rec_compliment, "d/mm/yyyy")
End Sub
you can always check before changing the format. See if below snippet helps
For I = 0 To edit_report_input.compliments_listbox.ListCount - 1
if edit_report_input.compliments_listbox.List(I, 4) <> "" Then
edit_report_input.compliments_listbox.List(I, 4) = Format(DateValue(edit_report_input.compliments_listbox.List(I, 4)), "d/mm/yyyy")
End If
Next I