使用 BASIC 脚本复制值和格式

Question

我想将 LibreOffice-Calc 工作表范围 (A1:H100) 中的值、格式和所有条件格式复制到同一工作簿的另一个（新/空）工作表。

这就是我实际做的：

sub blatt_einfuegen

  oActiveSheet = ThisComponent.CurrentController.ActiveSheet
  oTabellen = ThisComponent.Sheets
  sNewSheetName=oActiveSheet.getCellRangeByName("C1").String
  
  
  ' Prüfen, ob eine Tabelle mit dem Namen des Strings aus Zelle C1 existiert.
  If NOT oTabellen.hasbyName(sNewSheetName) Then
    ' Tabelle mit dem Namene sNewSheetName existiert nicht, also wird sie eingefügt.
    oTabellen.insertNewByName (sNewSheetName, 3)
  End If
  
  DIM oStart as Object, oZiel as Object

  oStart = ThisComponent.sheets.getByName("Aktuell")     '<--- Blatt wo die Daten stehen
  oZiel = ThisComponent.sheets.getByName(sNewSheetName)  '<--- Blatt wohin die Daten kopiert werden sollen

  ' Zellinhalte übertragen
  Dim aDataArray()  
  aDataArray = oStart.getCellRangeByName("A1:H100").getDataArray
  oZiel.getCellRangeByName("A1:H100").setDataArray(aDataArray)
 
  ' Spaltenbreiten übertragen
  For j = 0 To 6
    oZiel.Columns.getByIndex(j).Width = oStart.Columns.getByIndex(j).Width
  Next j

  Call CopyFormatBetweenSheets(sNewSheetName)
  
End Sub

Sub CopyFormatBetweenSheets(sName$)
    Dim oSourceSheet As Object
    Dim oTargetSheet As Object
    Dim oSourceRange As Object
    Dim oTargetRange As Object
    Dim i As Integer
    Dim j As Integer
    
    ' Get the source sheet (where the source range is located)
    oSourceSheet = ThisComponent.Sheets.getByName("Aktuell")
    
    ' Get the target sheet (where the target range is located)
    oTargetSheet = ThisComponent.Sheets.getByName(sName)    
    
    ' Define the source range (range with the formatting to be copied)
    oSourceRange = oSourceSheet.getCellRangeByName("A1:H100")
    
    ' Define the target range (range where the formatting will be applied)
    oTargetRange = oTargetSheet.getCellRangeByName("A1:H100")

    ' Copy the formatting from the source range to the target range
    For i = 0 To oSourceRange.Rows.getCount() - 1
       For j = 0 To oSourceRange.Columns.getCount() - 1
            oTargetRange.getCellByPosition(j, i).CharFontName = oSourceRange.getCellByPosition(j, i).CharFontName
            oTargetRange.getCellByPosition(j, i).CharHeight = oSourceRange.getCellByPosition(j, i).CharHeight
            oTargetRange.getCellByPosition(j, i).CharWeight = oSourceRange.getCellByPosition(j, i).CharWeight
            oTargetRange.getCellByPosition(j, i).NumberFormat = oSourceRange.getCellByPosition(j, i).NumberFormat
            oTargetRange.getCellByPosition(j, i).CharUnderline = oSourceRange.getCellByPosition(j, i).CharUnderline
            oTargetRange.getCellByPosition(j, i).HoriJustify = oSourceRange.getCellByPosition(j, i).HoriJustify
            oTargetRange.getCellByPosition(j, i).VertJustify = oSourceRange.getCellByPosition(j, i).VertJustify
            oTargetRange.getCellByPosition(j, i).ConditionalFormat = oSourceRange.getCellByPosition(j, i).ConditionalFormat

            ' Add more properties as needed (e.g., CharColor, CellBackColor, etc.)
       Next j
    Next i
End Sub

它复制值、格式，但仅复制第一个条件格式，即 oSourceRange 的单元格中定义的格式。

是否可以复制单元格的所有条件格式，或者是否有更好的方法将 oSourceRange 值、格式和条件格式复制到 oTargetRange？

通过数组方法 (.setDataArray) 复制值 - 是否有一种方法可以使用格式执行此操作？

Answer 1

如果您不介意复制这些源单元格中的所有内容，那么您可以使用调度来为您完成所有工作。

sub CopyCells(sinName$)
    rem --------------------------------------------------------------
    rem define variables
    dim oDoc   as object
    dim oFrame as object
    dim oDispatcher as object
    dim oFromSheet as object
    dim oToSheet as object
    dim oCell as object
    dim oCellRange as object
    rem --------------------------------------------------------------
    rem get access to the oDoc
    oDoc = ThisComponent
    oFrame = oDoc.CurrentController.Frame
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    oFromSheet = oDoc.Sheets.getByName("Aktuell")
    oToSheet = oDoc.Sheets.getByName(sinName)

    rem Select the region to copy
    oCellRange = oFromSheet.getCellRangeByName("A1:H100")
    oDoc.getCurrentController().Select(oCellRange)  
    oDispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())

    rem Goto the sheet and cell to paste into
    oCell = oToSheet.getCellByPosition(0,0)
    oDoc.getCurrentController().Select(oCell)   
    oDispatcher.executeDispatch(oFrame, ".uno:Paste", "", 0, Array())

end sub