CODEWITHSUNDEEP
vbalibreofficelibreoffice-calc
Martín
Martín

Reputation: 31

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.

Upvotes: 3

Views: 2215

Answers (1)

Epameinondas
Epameinondas

Reputation: 848

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

Upvotes: 1

Related Questions