主页 / computer / 问题 / 1817691
Accepted
JCB
Asked: 2023-11-22 14:58:26 +0800 CST

LibreOffice Calc 基本搜索和替换宏

  • 772

我正在尝试创建一个在 Calc 中使用的 LibreOffice Basic 宏，当在打开的电子表格文件中调用该宏时，将打开包含两个范围的第二个电子表格文件（第一个范围包含带有要搜索的正则表达式的单元格，第二个范围包含替换内容） text）然后将在调用它的工作表中搜索搜索范围内的所有项目，并将工作表中找到的任何项目替换为相应的替换单元格（包括替换单元格的格式）。我向 ChatGPT 寻求帮助，以下是它提供的一般内容，以及我对确定范围大小的逻辑所做的一些更正。

Sub SearchAndReplaceItems

    Dim oDoc As Object
    Dim oSearchReplaceDoc As Object
    Dim oSheet As Object
    Dim oSearchReplaceSheet As Object
    Dim oSearchDescriptor As Object
    Dim oSearchRange As Object
    Dim oReplaceDescriptor As Object
    Dim oCell As Object
    Dim oFound As Object
    Dim nSearchColumn As Integer
    Dim nReplaceColumn As Integer
    Dim nLastRow As Integer

    ' Get the current document
    oDoc = ThisComponent

    ' Specify the path to the Corrections spreadsheet
    Dim sSearchReplaceFilePath As String
    sSearchReplaceFilePath = "C:\Users\One\Info\Corrections.ods"

    ' Open the Corrections spreadsheet
    oSearchReplaceDoc = StarDesktop.loadComponentFromURL(ConvertToURL(sSearchReplaceFilePath), "_blank", 0, Array())
    oSearchReplaceSheet = oSearchReplaceDoc.Sheets(0)

    ' Specify the column numbers for search and replace text
    nSearchColumn = 1 ' Assuming search text is in column A
    nReplaceColumn = 2 ' Assuming replace text is in column B

    ' Get the range for the search regular expressions
    oSearchRange = oSearchReplaceDoc.Sheets(0).getCellRangeByName("SearchRegExps")

    ' Get the last row with data in the SearchRegExps range
    nLastRow = oSearchRange.Rows.getCount()

    ' Loop through each row History Item Corrections sheet
    For i = 1 To nLastRow
        ' Get search and replace values from the current row
        Dim sSearchText As String
        Dim sReplaceText As String
        sSearchText = oSearchReplaceSheet.getCellByPosition(nSearchColumn - 1, i).getString()
        sReplaceText = oSearchReplaceSheet.getCellByPosition(nReplaceColumn - 1, i).getString()

        ' Create search and replace descriptors
        oSearchDescriptor = oDoc.createSearchDescriptor()
        oSearchDescriptor.SearchString = sSearchText

        oReplaceDescriptor = oDoc.createReplaceDescriptor()
        oReplaceDescriptor.ReplaceString = sReplaceText

        ' Execute the search
        oFound = oDoc.createReplaceDescriptor()
        oFound = oDoc.findFirst(oSearchDescriptor)

        ' Replace each occurrence found
        Do While Not IsNull(oFound)
            oCell = oFound.Cell
            oCell.setString(sReplaceText)

            ' Copy formatting from replace cell to the found cell
            CopyCellFormatting(oCell, oFound.Cell)

            ' Find the next occurrence
            oFound = oDoc.findNext(oFound)
        Loop
    Next i

    ' Close the search and replace document
    oSearchReplaceDoc.Close(True)
End Sub

Sub CopyCellFormatting(oSourceCell, oTargetCell)
    ' Copy character formatting
    oTargetCell.CharFontName = oSourceCell.CharFontName
    oTargetCell.CharHeight = oSourceCell.CharHeight
    oTargetCell.CharWeight = oSourceCell.CharWeight
    oFound.Cell.CharAutoKerning = oCell.CharAutoKerning
    oFound.Cell.CharKerning = oCell.CharKerning
    oFound.Cell.CharScaleWidth = oCell.CharScaleWidth

    ' Copy border formatting
    oTargetCell.BottomBorder = oSourceCell.BottomBorder
    oTargetCell.TopBorder = oSourceCell.TopBorder
    oTargetCell.LeftBorder = oSourceCell.LeftBorder
    oTargetCell.RightBorder = oSourceCell.RightBorder

End Sub

当我运行宏时出现错误

基本运行时错误。未找到属性或方法：createSearchDescriptor。

发生在宏的第 50 行，即：

oSearchDescriptor = oDoc.createSearchDescriptor()

我理解对象 oDoc（调用宏的文档）没有名为 createSearchDescriptor 的属性或方法，但我不知道足够的 LibreOffice Basic 来确定它应该在这里做什么，以便它能够工作。我浏览了 Andrew Pitonyak 的书“OpenOffice.org 的有用宏信息”和他的“OpenOffice.org 宏解释”书，但没有在其中找到任何有关使用 SearchDescriptors 的内容。

我怀疑如果第 53 行的语句会发生类似的错误

oReplaceDescriptor = oDoc.createReplaceDescriptor()

被处决。

如果此代码中存在其他错误导致其无法成功运行，我不会感到惊讶。

如果您能提供有关如何通过此宏实现我想要实现的目标的任何见解，我将不胜感激。

macros

1 个回答

  1. Best Answer

    我会一步步告诉你这个问题是如何解决的。

    主要问题是复制替换单元格以及格式。有多种方法可以执行此操作 - 通过剪贴板（通常的复制和粘贴 - 第5.23.1 章. 使用剪贴板复制电子表格单元格）、使用.getTransferable()（第5.23.6 章. 剪贴板的替代方案 - 可传输内容）。但最有效的方法是oSheet.CopyRange()（第5.23.2 章。在没有剪贴板的情况下复制电子表格单元格）

    不幸的是，此方法仅在单个电子表格中有用，并且您的数据和替换列表位于不同的电子表格中。因此，我们将使用一个不是很复杂的技巧 - 我们将在当前工作簿中创建一个临时工作表，其中包含替换列表的副本，完成工作后我们将删除它。

    通常将所有 Dim 运算符放在过程的开头。我将在使用每个变量之前对其进行描述。

    为了不在需要更改文本字符串的情况下在整个宏代码中搜索文本字符串，我们将它们放在过程的开头：

    Sub SearchAndReplaceItems
Const sSearchReplaceFilePath = "C:\Users\One\Info\Corrections.ods"
Const sSearchReplaceRangeName = "SearchRegExps"

    与往常一样，初步数据检查和配置占据了大部分代码。

    工具库包含许多有用的函数。我们将使用GetDocumentType()函数和OpenDocument()函数

        GlobalScope.BasicLibraries.LoadLibrary("Tools")
' Get the current document
Dim oDoc As Variant 
    oDoc = ThisComponent
    If GetDocumentType(oDoc) <> "scalc" Then
        MsgBox "This macro is intended for use with spreadsheets only!", MB_ICONSTOP, "Continuation of work is impossible"
        Exit Sub
    EndIf

    如果替换字典不存在，那么其他一切都没有意义

        If Not FileExists(sSearchReplaceFilePath) Then
        MsgBox "File '" & sSearchReplaceFilePath & "' not found!", MB_ICONSTOP, "Continuation of work is impossible"
        Exit Sub
    EndIf 
Dim oSearchReplaceDoc As Variant 
    oSearchReplaceDoc = OpenDocument(ConvertToURL(sSearchReplaceFilePath), Array())

    让我们确保替换的电子表格没有损坏

    Dim oNamedRanges As Variant
    oNamedRanges = oSearchReplaceDoc.NamedRanges
    If Not oNamedRanges.hasByName(sSearchReplaceRangeName) Then
        MsgBox "The '" & sSearchReplaceFilePath & "' file does not contain a named range '" _
            & sSearchReplaceRangeName & "'!", MB_ICONSTOP, "Continuation of work is impossible"

    此时我们可以关闭参考电子表格 oSearchReplaceDoc.close(true)。但由于您很可能想要纠正检测到的错误，因此我们不会这样做

            Exit Sub
    EndIf

    让我们收集有关替换范围的必要信息：工作表的名称以及该工作表上命名范围的位置

    Dim NamedRange As Variant
Dim oReferredCells As Variant
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim nStartColumn As Long
Dim nStartRow As Long
Dim nEndRow As Long
Dim sSheetName As String
    NamedRange = oSearchReplaceDoc.NamedRanges.getByName(sSearchReplaceRangeName)

    oReferredCells = NamedRange.getReferredCells()
    aRangeAddress = oReferredCells.getRangeAddress()
    nStartColumn = aRangeAddress.StartColumn
    nStartRow = aRangeAddress.StartRow
    nEndRow = aRangeAddress.EndRow
    sSheetName = oReferredCells.getSpreadsheet().getName()

    现在我们实际上可以关闭替换电子表格 - 我们将以另一种方式访问​​其数据。

        oSearchReplaceDoc.close(true)

    所有进一步的工作仅使用当前电子表格进行oDoc

    为了确保辅助附加表的名称与已经存在的表不重合，我们将为它起一个“几乎随机”的名称：

    Dim sTempSheetName As String
    sTempSheetName = sSearchReplaceRangeName & Format(Timer,"0")

    让我们确保当前电子表格中没有这样的工作表（如果有，则将其删除），并在电子表格的末尾创建一个新工作表。使用link()方法，将替换列表中的数据复制到其中：

    Dim oSheets As Variant
Dim nCount As Long
Dim oTempSheet As Variant
    oSheets = ThisComponent.getSheets()
    If oSheets.hasByName(sTempSheetName) Then oSheets.removeByName(sTempSheetName)
    nCount = oSheets.getCount()
    oSheets.insertNewByName(sTempSheetName, nCount)
    oTempSheet = oSheets.getByIndex(nCount)
    oTempSheet.link(ConvertToURL(sSearchReplaceFilePath), sSheetName, "calc8", "", com.sun.star.sheet.SheetLinkMode.VALUE)

    现在所有的初步检查和设置都已经完成，实际的搜索和替换就非常简单了。

    Dim nCountReplacements As Long 
Dim nNextSheet As Long 
Dim oNextSheet As Variant
Dim nReplRow As Long 
Dim oSearchDescriptor As Variant
Dim sSearchStr As String 
Dim oFormattedCellAddress As Variant
Dim oFound As Variant
Dim oCell As Variant

    对于电子表格中的每个工作表（最后一个工作表除外 - 最后一个工作表是替换列表）创建一个搜索描述符，设置其参数SearchRegularExpression并且SearchType（1表示“在值中搜索”）

        For nNextSheet = 0 To nCount-1
        oNextSheet = oSheets.getByIndex(nNextSheet)
        oSearchDescriptor = oNextSheet.createSearchDescriptor()
        oSearchDescriptor.SearchRegularExpression = True
        oSearchDescriptor.SearchType = 1

    对于替换列表中的每一行，获取搜索字符串和替换单元格的地址（请参阅章节5.23.2. 在不使用剪贴板的情况下复制电子表格单元格）

            For nReplRow = nStartRow To nEndRow
            sSearchStr = oTempSheet.getCellByPosition(nStartColumn, nReplRow).getString()
            oFormattedCellAddress = oTempSheet.getCellByPosition(nStartColumn+1, nReplRow).getRangeAddress()
            oSearchDescriptor.setSearchString(sSearchStr)
            oFound = oNextSheet.findAll(oSearchDescriptor)

    如果下一个正则表达式的搜索成功，则迭代所有找到的单元格并将示例单元格复制到其中。同时，我们还会统计报告的替换次数。

                If Not IsNull(oFound)  Then 
                For Each oCell In oFound.getCells()
                    oTempSheet.copyRange(oCell.getCellAddress(), oFormattedCellAddress)
                    nCountReplacements = nCountReplacements + 1

    这就是全部。关闭所有检查和循环，移除辅助表，报告工作完成情况：

                    Next oCell
            EndIf 
        Next nReplRow
    Next nNextSheet
    If oSheets.hasByName(sTempSheetName) Then oSheets.removeByName(sTempSheetName)
    MsgBox nCountReplacements & " substitutions made", MB_ICONINFORMATION, "Done"
End Sub

    希望这有帮助

    • 2

相关问题