How to copy data into cells, make a table and add more data to it

Question

UI looks like:
Account:Wessex bank plc
Income: 200€
Costs:
Date: 28.02.2021
Output should be a list below in the cells:
Date: | Account: | Income: | Costs: |

28.02.2021 | Wessex Bank plc | 200€ |
28.02.2021 | Food | - | 175€ |
Hint: I would like to have a list of 5-7 bookings and when
making a new booking the latest booking is going to be at the top position and the first booking in the last row, like when the table starts at row 13 and I make 5 bookings with different accounts, the first booking will be at 17 in the end.
this is copying the content in the table

Sub MyBuchenMakro   
    Dim currDoc As Object
    Dim currSheet As Object
    Dim curr Cell As Object
    Dim destCell As Object  
    Dim oDate As Date
    Dim einnahmen As Currency
    Dim ausgaben As Currency  
    currDoc = ThisComponent
    currSheet = currDoc.sheets(0)  
    currCell = currSheet.getCellByPosition(1, 5)
    destCell = currSheet.getCellByPosition(1, 12)
    destCell.String = currCell.String  
    currCell = currSheet.getCellByPosition(1, 6)
    destCell = currSheet.getCellByPosition(2, 12)
    destCell.setValue(CCur(currCell.getValue()))  
    currCell = currSheet.getCellByPosition(1, 7)
    destCell = currSheet.getCellByPosition(3, 12)
    destCell.setValue(CCur(currCell.getValue()))  
    currCell = currSheet.getCellByPosition(1, 8)
    destCell = currSheet.getCellByPosition(0, 12)
    destCell.setValue(CDate(currCell.getValue()))    
For i = 160 To 13 Step 1
  destCell = currSheet.getCellByPosition(0, i)
  If destCell == "" Then
     GoTo Continue
  End if
destCell = currSheet.getCellByPosition(0,i+1)
destCell.setValue(CDate(currCell.getValue()))
currCell = currSheet.getCellByPosition(1,i)
destCell = currSheet.getCellByPosition(1,i+1)
destCell.String = currCell.String
currCell = currSheet.getCellByPosition(2,i)
destCell = currSheet.getCellByPosition(2,i+1)
destCell.setValue(CCur(currCell.getValue()))
currCell = currSheet.getCellByPosition(3,i)
destCell = currSheet.getCellByPosition(3,i+1)
destCell.setValue(CCur(currCell.getValue()))
 Next i
End Sub  


  [1]: https://i.stack.imgur.com/Mw7pJ.png

Welcome! As I understand your code, line 12 is already filled with the heading "Date: | Account: | Income: | Costs: |"? And the whole task comes down to finding in an already filled table a line with a booking date no greater than the date entered in the "input form" Date field, insert a new row in this place and transfer the values of four input fields to this new row, isn't it ? — JohnSUN, Jun 02 '21 at 08:10
Line 12 will be the titles of the table. I would like to add the date to the table too. I don't compare the date with something. — Tobi S, Jun 02 '21 at 08:33

score 1 · Accepted Answer · answered Jun 02 '21 at 09:57

In fact, it is written a little shorter:

Option Explicit 
Sub BuchenMacro
Dim oCurrentController As Variant   ' get Activesheet and select first cell of form
Dim oSheet As Variant   ' Activesheet
Dim oSourceRange As Variant ' Range B6:B9 - fields of input form
Dim oDataArray As Variant           ' Data from input form
    oCurrentController = ThisComponent.getCurrentController()
    oSheet = oCurrentController.getActiveSheet()
Rem Range with data
    oSourceRange = oSheet.getCellRangeByName("B6:B9")
Rem Data from this range as "array of arrays"
    oDataArray = oSourceRange.getDataArray()
Rem To prevent insert empty row - validate source cells:
Rem If 3 first cells are empty then stop:
    If Trim(oDataArray(0)(0))+Trim(oDataArray(1)(0))+Trim(oDataArray(2)(0)) = "" Then Exit Sub 
Rem "Transpose" source data to single row:
    oDataArray = Array(Array(oDataArray(3)(0), oDataArray(0)(0), oDataArray(1)(0), oDataArray(2)(0)))
Rem Insert new row after header and shift all other rows down:
    oSheet.getRows().insertByIndex(12, 1)
Rem Paste data from form to this new row
    oSheet.getCellRangeByPosition(0, 12, 3, 12).setDataArray(oDataArray)
Rem Clear input cells to prevent duplicates
Rem (Only the data is cleared, the formulas remain in place. 
Rem Put in cell B9 the formula =TEXT(TODAY();"DD.MM.YYYY")
Rem and it will always show the current date)
    oSourceRange.clearContents(7)
Rem Select first cell
    oCurrentController.Select(oSheet.getCellByPosition(1,5))
Rem Deselect cell
    oCurrentController.Select(ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges"))
End Sub

Thank you, it works just fine, but I have got a small problem: In my table I made the column titles Income and Costs colored (green and red) and when running your macro, the data will be put into the table, however Libre is taking the format from the cells above and colors the data records then too — Tobi S, Jun 02 '21 at 10:15
Yes, that's a problem. But this is solved with one line of code. Clear it immediately after inserting a new row `oSheet.getCellRangeByPosition(0, 12, 3, 12).clearContents(32)` For the values of the parameters of the `.clearContents()` method, see [**here**](http://www.openoffice.org/api/docs/common/ref/com/sun/star/sheet/CellFlags.html) — JohnSUN, Jun 02 '21 at 10:22
yes, thanks that fixes the problem, however when I insert it after or before the row insertion, the format of data records are going to be set differently. Actually the currency and the date format is transformed into a number format, for instance instead of the date I am getting the numeric value of the date. — Tobi S, Jun 02 '21 at 11:01

How to copy data into cells, make a table and add more data to it

1 Answers1