如何将数据复制到单元格中，制作表格并向其中添加更多数据

Question

界面如下：
帐户：威塞克斯银行有限公司
收入：200 欧元
费用：
日期：28.02.2021
输出应该是下面单元格中的列表：
日期： |帐户： |收入：|费用：|

28.02.2021 |威塞克斯银行 | 200 欧元 |
2021 年 2 月 28 日 |食品 | - | 175 欧元 |
提示：我想要一份包含 5-7 次预订的清单以及时间
进行新预订 最新预订将位于顶部位置，第一个预订位于最后一行，例如当表格从第 13 行开始并且我使用不同帐户进行 5 次预订时，第一个预订将在第 17 行结束。
这是复制表格中的内容

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

Answer 1

其实写的稍微短一点：

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