Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Run existing Macro only on Selected Cells, instead of the whole sheet

I have the following macro (LibreOffice Calc):

Sub CalcFindAndReplace
    Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet
    oDoc = ThisComponent
    aFind = Array("Mecanica","Cancion","Murcielago")
    aReplace = Array("Mecánica","Canción","Murciélago")
    aRayCount = 0
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    FandR = oSheet.createReplaceDescriptor
    FandR.SearchCaseSensitive = true
    FandR.SearchWords = true ' 1 to A but not 11 to AA
    FandR.SearchRegularExpression = true

    While aRayCount <= uBound(aFind)
        FandR.setSearchString(aFind(aRayCount))
        FandR.setReplaceString(aReplace(aRayCount))
        aRayCount = aRayCount + 1
        oSheet.ReplaceAll(FandR)
    End While

End Sub

It works fine, but I need to add it the ability to be applied only on manual selections of cells (different each time), not on all the cells of the sheet.

like image 593
Martín Avatar asked Nov 30 '25 02:11

Martín


1 Answers

EDITED

The following code will take the currently selected cells, will replace each cell with the actual String value (beware: a calc function that may act on a cell will removed permanently) and then will replace the strings cells as desired.

Motivated by http://www.oooforum.org/forum/viewtopic.phtml?t=137064 and http://www.oooforum.org/forum/viewtopic.phtml?t=71015 and http://www.oooforum.org/forum/viewtopic.phtml?t=65318 ...

Sub ReplaceEachCellWithActualValue()
    ' Gets the current user selection and replace each cell with the actual String value
    Dim oDoc, oSheet, oCell As Object
    oDoc = ThisComponent
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    RangeAddress = oDoc.getCurrentSelection.getRangeAddress 

    c1 = RangeAddress.StartColumn
    r1 = RangeAddress.StartRow
    c2 = RangeAddress.EndColumn
    r2 = RangeAddress.EndRow

    for i = c1 to c2
            for j = r1 to r2 
                    Dim cellasstring As String
                    oCell = oSheet.getCellByPosition(i, j)
                    cellasstring = oCell.string
                    oSheet.getCellByPosition(i, j).String = cellasstring
            next j
    next i

End Sub

Sub CalcFindAndReplace

    ' first replace all formulas on the selected cells with actual strings...
    ReplaceEachCellWithActualValue()

    ' Then replace as desired...  
    Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet        
    oDoc = ThisComponent
    aFind = Array("Mecanica","Cancion","Murcielago")
    aReplace = Array("Mecánica","Canción","Murciélago")
    aRayCount = 0
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    FandR = oSheet.createReplaceDescriptor
    FandR.SearchCaseSensitive = true
    FandR.SearchWords = true ' 1 to A but not 11 to AA
    FandR.SearchRegularExpression = true

    Dim oSelection as Object
    oSelection = oDoc.CurrentController.getSelection

    While aRayCount <= uBound(aFind)
        FandR.setSearchString(aFind(aRayCount))
        FandR.setReplaceString(aReplace(aRayCount))
        oSelection.ReplaceAll(FandR) 
        aRayCount = aRayCount + 1
    Wend
End Sub
like image 127
Epaminondas Avatar answered Dec 03 '25 10:12

Epaminondas



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!