1

I am attempting to create a LibreOffice Basic macro for use in Calc that when invoked in an open spreadsheet file will open a second spreadsheet file that contains two ranges, (the first range containing cells with regular expressions to search for and the second containing the replacement text) then will search in the sheet it was invoked from for all the items in the search range and replace any items found in the working sheet with the corresponding replacement cell including cell the formatting of the replacement cell. I asked ChatGPT for help and the following is in general what it supplied, with some corrections that I made to the logic that determines the size of the range.


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

When I run the macro the error

BASIC runtime error. Property or method not found: createSearchDescriptor.

occurs on line 50 of the macro, which is:

oSearchDescriptor = oDoc.createSearchDescriptor()

I comprehend that the object oDoc (the document that the macro was invoked from) does not have a property or method named createSearchDescriptor, but I don't know enough LibreOffice Basic to figure what it should be doing here so that it will work. I looked through Andrew Pitonyak's book "Useful Macro Information For OpenOffice.org" and his "OpenOffice.org Macros Explained" book but did not find anything in them about using SearchDescriptors.

I suspect that a similar error would occur if the statement on line 53

oReplaceDescriptor = oDoc.createReplaceDescriptor()

were to be executed.

It would not surprise me if there were other errors in this code that will prevent it from running successfully.

I would greatly appreciate any insight that can be provided into how I can achieve what I desire to accomplish with this macro.

13
  • 2
    Yes, you are right - the spreadsheet does not have a .createSearchDescriptor() method, every sheet of the spreadsheet has this method. By the way, how many sheets are in your modifiable workbook? Should the replacement be carried out on each of these sheets or only on the first? (Seeking help from the AI was not the best way to solve the problem)
    – JohnSUN
    Commented Nov 22, 2023 at 7:28
  • Voted to close this question because use of ChatGPT is banned on Super User.
    – Jim K
    Commented Nov 22, 2023 at 12:44
  • Microsoft invested $10 billion in ChatGPT. Do you really expect that after this the AI will give reasonable advice on how to use the free office?
    – JohnSUN
    Commented Nov 22, 2023 at 16:03
  • @JimK I think you misunderstand the ban. ChatGPT is perfectly valid for "doing your homework", though it is probably a poor choice unless you have some knowledge already to check its info against. The ban is against using that tool to generate questions or answers. OP used it to try to solve their own problem first. Commented Nov 23, 2023 at 16:16
  • @JohnSUN it does not follow. MS supports tons of open source and free products, and ChatGPT gives silly code answers to tons of MS product questions too. Commented Nov 23, 2023 at 16:17

1 Answer 1

4

I will tell you how this problem is solved step by step.

The main problem is copying the replacement cell along with the formatting. There are several ways to perform this operation - through the clipboard (the usual copy and paste - chapter 5.23.1. Copy Spreadsheet Cells With The Clipboard), using .getTransferable() (chapter 5.23.6. An alternative to the clipboard – transferable content). But the most effective method is oSheet.CopyRange() (chapter 5.23.2. Copy Spreadsheet Cells Without The Clipboard)

Unfortunately, this method is only useful within a single spreadsheet, and your data and the substitution list are in different spreadsheets. Therefore, we will use a not very complicated trick - we will create a temporary sheet in the current workbook with a copy of the list of replacements, and after finishing the work we will delete it.

It is customary to place all Dim operators at the beginning of the procedure. I will describe each variable immediately before using it.

In order not to search for text strings throughout the macro code in case you need to change them, we place them at the very beginning of the procedure:

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

As always, preliminary data checking and configuration takes up most of the code.

The Tools library contains many useful functions. We will use GetDocumentType() function and OpenDocument() function

    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 the replacement dictionary does not exist, then everything else is meaningless

    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())

Let's make sure the spreadsheet of substitutions is not corrupted

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"

At this point we could close the reference spreadsheet oSearchReplaceDoc.close(true). But since you most likely want to correct the detected error, we will not do this

        Exit Sub
    EndIf 

Let's collect the necessary information about the range of replacements: the name of the sheet and the location of the named range on this sheet

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()

Now we can actually close the substitution spreadsheet - we will get access to its data in another way.

    oSearchReplaceDoc.close(true)

All further work is carried out only with the current spreadsheet oDoc

To ensure that the name of the auxiliary additional sheet does not coincide with an already existing sheet, we will come up with an “almost random” name for it:

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

Let's make sure that there is no such sheet in the current spreadsheet (and if there is, then delete it) and create a new sheet at the end of the spreadsheet. Using the link() method, copy the data from the list of replacements into it:

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)

Now that all the preliminary checks and settings have been made, the actual search and replace is very simple.

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

For each sheet in the spreadsheet (except the last one - the last sheet is the list of replacements) create a search descriptor, set its parameters SearchRegularExpression and SearchType (1 means "search in values")

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

For each line in the replacement list, get the search string and the address of the replacement cell (see chapter 5.23.2. Copy Spreadsheet Cells Without The Clipboard)

        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 the search for the next regular expression was successful, iterate through all the found cells and copy the sample cell into them. At the same time, we count the number of replacements performed for the report.

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

This is all. Close all checks and cycles, remove the auxiliary sheet, report completion of work:

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

Hope this was helpful

1
  • Thank you very much, JohnSun, I will study your answer and try it out at the first opportunity that I get.
    – JCB
    Commented Nov 22, 2023 at 21:03

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .