I have 3 tables in a single form, they use SQL queries to select the data. I need to refresh them somehow, but nothing works.
E.g. this doesn't work at all:
oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
oDataSource = oBaseContext.getByName(dbName)
oCon = oDataSource.getConnection("", "")
oCon.getTables().refresh()
And this updates only the first table:
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
oFrame = ThisComponent.getCurrentController().getFrame()
oDisp.executeDispatch(oFrame, ".uno:Refresh", "", 0, Array())
How do I update them all?
Oh my god, it was so easy, I feel dumb now:
Sub reloadAllTables
Dim Forms : Forms = ThisComponent.DrawPage.Forms
Dim i%
For i = 0 To Forms.getCount()-1
Forms.getByIndex(i).reload()
Next
End Sub
Reloading forms doesn't refresh tables, table controls are refreshed by using .refresh on each column, for example-
SUB refreshTables(oForm as object)
DIM cnt as integer, cnt2 as integer, tot as integer, tot2 as integer
DIM oFormObj as object
'get number of form object
tot = oForm.getCount - 1
IF tot > -1 THEN
FOR cnt = 0 TO tot
'next form object
oFormObj = oForm.getByIndex(cnt)
'is object a table control AKA grid control
IF oFormObj.ImplementationName = "com.sun.star.comp.forms.OGridControlModel" THEN
'refresh each column
tot2 = oFormObj.getCount - 1
IF tot2 > -1 THEN
FOR cnt2 = 0 TO tot2
oFormObj.getByIndex(cnt2).refresh
NEXT
ENDIF
ENDIF
NEXT
ENDIF
END SUB
Related
I am creating a custom Dialog where the user is supposed to select one of multiple possible entries. I use a List Box to list the possible entries to be selected from.
There are multiple variables for each row, therefore I would like to use a table to properly align the entries. Is there a possibility to do so?
What i have:
abcdefg hijkl mnopq
abcd efghijk lmno
What i want:
abcdefg hijkl mnopq
abcd efghilkl mno
Use a fixed-width font for the list box, and pad the strings with spaces.
Sub PaddedListboxItems
oListBox.addItems(Array(
PaddedItem(Array("abcdefg", "hijkl", "mnopq")),
PaddedItem(Array("abcd", "efghijk", "lmno"))), 0)
End Sub
Function PaddedItem(item_strings As Array)
PaddedItem = PadString(item_strings(0), 10) & _
PadString(item_strings(1), 11) & item_strings(2)
End Function
Function PadString(strSource As String, lPadLen As Long)
PadString = strSource & " "
If Len(strSource) < lPadLen Then
PadString = strSource & Space(lPadLen - Len(strSource))
End If
End Function
More ways to pad strings in Basic are at http://www.tek-tips.com/viewthread.cfm?qid=522164, although not all of them work in LibreOffice Basic.
Yes, it is possible.
Create a new dialog and at the bottom, add a label.
Create a new module and add following code:
Option Explicit
Option Base 0
Dim oDialog1 As Object, oDataModel As Object, oListener As Object
Sub OpenDialog()
Dim oGrid As Object, oGridModel As Object, oColumnModel As Object, oCol As Object
Dim oLabel1 As Object, rect(3) As Integer
DialogLibraries.LoadLibrary("Standard")
oDialog1 = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oGridModel = oDialog1.getModel().createInstance("com.sun.star.awt.grid.UnoControlGridModel")
oLabel1 = oDialog1.getModel().getByName("Label1")
rect(0) = oLabel1.getPropertyValue("PositionX")
rect(1) = 10
rect(2) = oLabel1.getPropertyValue("Width")
rect(3) = oLabel1.getPropertyValue("PositionY") - 2*rect(1)
With oGridModel
.PositionX = rect(0)
.PositionY = rect(1)
.Width = rect(2)
.Height = rect(3)
End With
oColumnModel = oGridModel.ColumnModel
oCol = oColumnModel.createColumn()
oCol.Title = "Column 1"
oColumnModel.addColumn(oCol)
oCol = oColumnModel.createColumn()
oCol.Title = "Column 2"
oColumnModel.addColumn(oCol)
oCol = oColumnModel.createColumn()
oCol.Title = "Column 3"
oColumnModel.addColumn(oCol)
oDialog1.getModel().insertByName("grid", oGridModel)
oGrid = oDialog1.getControl("grid")
oListener = (CreateUnoListener("grid_", "com.sun.star.awt.grid.XGridSelectionListener"))
oGrid.addSelectionListener(oListener)
oDataModel = oGridModel.GridDataModel
oDataModel.addRow("a", Array("abcdefg", "hijkl", "mnopq"))
oDataModel.addRow("b", Array("abcd", "efghijk", "lmno"))
oDialog1.execute()
oDialog1.dispose()
End Sub
To get the values of the selected row, add a listener for the grid_selectionChanged event:
Sub grid_selectionChanged(ev)
Dim oRows() As Object, oLabel1 As Object, sCells(2) As String
oRows = ev.Source.getSelectedRows()
oLabel1 = oDialog1.getModel().getByName("Label1")
sCells(0) = oDataModel.getRowData(oRows(0))(0)
sCells(1) = oDataModel.getRowData(oRows(0))(1)
sCells(2) = oDataModel.getRowData(oRows(0))(2)
oLabel1.setPropertyValue("Label", "Selected values: " + sCells(0) + "," + sCells(1) + "," + sCells(2))
End Sub
If you did all correctly, by running OpenDialog you should get your grid:
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
I have a small program for some college coursework, i have to enter data of the gender and age of a group of people then work out the male and female percent and the child and adult percent. The bit i am stuck with is i want to display my results on labels on a separate form. Here is my code:
Public Class Form1
Dim TotalGender As Integer
Dim TotalAge As Integer
Dim MaleCount As Integer
Dim FemaleCount As Integer
Dim ChildCount As Integer
Dim AdultCount As Integer
Dim MalePercent As Single
Dim FemalePercent As Single
Dim AdultPercent As Single
Dim ChildPercent As Single
Private Sub btnSub_Click(sender As Object, e As EventArgs) Handles btnSub.Click
If cmbGender.Text = "Male" Then
MaleCount += 1
End If
If cmbGender.Text = "Female" Then
FemaleCount += 1
End If
If cmbAge.Text > 18 Then
ChildCount += 1
End If
If cmbAge.Text <= 18 Then
AdultCount += 1
End If
End Sub
Private Sub btnResults_Click(sender As Object, e As EventArgs) Handles btnResults.Click
Form2.Show()
MalePercent = MaleCount / TotalGender * 100
FemalePercent = FemaleCount / TotalGender * 100
AdultPercent = AdultCount / TotalAge * 100
ChildPercent = ChildCount / TotalAge * 100
End Sub
Private Sub btnReset_Click(sender As Object, e As EventArgs) Handles btnReset.Click
TotalGender = 0
TotalAge = 0
MaleCount = 0
FemaleCount = 0
ChildCount = 0
AdultCount = 0
MalePercent = 0
FemalePercent = 0
AdultPercent = 0
ChildPercent = 0
End Sub
End Class
My second form has all the labels already placed and i know how to display results on a label, i just don't know how to transfer the results across to another form
You can write on form 1 .It shows your results on form2
Form2.Label1.Text = AdultCount
Form2.Show()
Basically what I am trying to do is, sending an email for every used row on the target worksheet, each row has the details of the addresses, subject line, table with values etc.
So I can't seem to get it working, as it only dispatches one email from the first target row (2nd row).
I have tried using a combination of For Each and For i = 1 to LR which aren't working. I suspect it is to do with the cell references.
Here is the code:
Sub TestEmail1()
Application.ScreenUpdating = False
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim ccAddresses As Range, ccCell As Range, ccRecipients As String
Dim rngeSubject As Range, SubjectCell As Range, SubjectContent As Variant
Dim rngeBody As Range, bodyCell As Range, bodyContent As Variant
Dim Table1 As Range
Dim i As Integer
For Each c In ActiveSheet.UsedRange.Columns("A").Cells
Set rng = ActiveSheet.UsedRange
LRow = rng.Rows.Count
For i = 2 To LRow
Set Table1 = Worksheets(1).Range("K1:R1")
Set Table2 = Worksheets(2).Range("K" & i & ":" & "R" & i)
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'set sheet to find address for e-mails as I have several people to
'mail to
Set rngeAddresses = ActiveSheet.Range("B" & i)
For Each rngeCell In rngeAddresses.Cells
strRecipients = strRecipients & ";" & rngeCell.Value
Next
Set ccAddresses = ActiveSheet.Range("C" & i)
For Each ccCell In ccAddresses.Cells
ccRecipients = ccRecipients & ";" & ccCell.Value
Next
Set rngeSubject = ActiveSheet.Range("D" & i)
For Each SubjectCell In rngeSubject.Cells
SubjectContent = SubjectContent & SubjectCell.Value
Next
Set rngeBody = ActiveSheet.Range("E" & i)
For Each bodyCell In rngeBody.Cells
bodyContent = bodyContent & bodyCell.Value
Next
'set Importance
'aEmail.Importance = 2
'Set Subject
aEmail.Subject = rngeSubject
'Set Body for mail
'aEmail.Body = bodyContent
aEmail.HTMLBody = bodyContent & "<br><br><br>" & RangetoHTML_ (Table1)
aEmail.To = strRecipients
aEmail.CC = ccRecipients
aEmail.Send
Exit Sub
Next i
Next c
End Sub
There is an Exit Sub at the end of your inner loop that makes the code exit from the procedure after the first iteration:
Sub TestEmail1()
...
For Each c In ActiveSheet.UsedRange.Columns("A").Cells
...
For i = 2 To LRow
...
Exit Sub
Next i
Next c
End Sub
Remove it and processing should continue as desired.
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