Use the object inspection tool to examine the selected range (ranges). Maybe you need one more loop to handle the non adjacent ranges (the Range array). Use the GetByIndex method to get each of the selected ranges. Maybe you need determine the type of the selection before (if it is a Range or Range array)
1 Like
REM ***** BASIC *****
option explicit
Sub findAndUnderline
Dim oCurrSel as object
Dim oRange as object
Dim sTarget As String
Dim selIndex as integer
sTarget = InputBox ("Search phrase")
oCurrSel = ThisComponent.CurrentSelection
'xray oCurrSel
if oCurrSel.ImplementationName = "ScCellRangesObj" then
Print "Some Ranges are selected"
For selIndex = 0 to oCurrSel.getCount() - 1
oRange = oCurrSel.getByIndex(selIndex)
MarkStrings(oRange, sTarget)
Next
end if
if oCurrSel.ImplementationName = "ScCellRangeObj" then
Print "One Range is selected"
oRange = oCurrSel
MarkStrings(oRange, sTarget)
end if
if oCurrSel.ImplementationName = "ScCellObj" then
Print "One Cell is selected"
oRange = oCurrSel
MarkStrings(oRange, sTarget)
end if
End Sub
Sub MarkStrings(oOneRange as object, sText as string)
Dim oCell as object
dim tc as object
Dim i, j, start, pos as integer
For i = 0 To oOneRange.Rows.getCount() - 1
For j = 0 To oOneRange.Columns.getCount() - 1
oCell = oOneRange.getCellByPosition( j, i )
REM https://stackoverflow.com/questions/35239915/find-all-strings-within-a-string
start = 1
Do
pos = InStr(start, oCell.String, sText)
If pos > 0 Then
start = pos + 1
tc = oCell.CreateTextCursorByRange(oCell.Start)
tc.goRight(pos - 1, False)
tc.goRight(Len(sText), True)
tc.CharUnderline = 2
End If
Loop While pos > 0
Next
Next
End Sub
1 Like
That is fantastic, thank you very much for your suggestions and implementation! It works much better now. Also it shows many good conventions and techniques for writing Basic that I need to start using as well. 'xray also seems interesting.
I was wondering if you might also know if there is some ātrickā in Calcās basic to batch together TextCursors operations so undoing them would act on all of them after the script runs?
If you are using the Cell Styles (read: ONLY the Cell Styles) for the formatting of the spreadsheet, then you can use the Ctrl-A + Ctrl-M key combinations to delete all of the direct (manual) formatting properties. These underscores (applied by the macro) are direct formatting properties.
You can use the MRI too. Install one of them (XrayTool or MRI) and delete the ā character (that means: REM) from the code the Object Inspector will list the properties and methods (and more) of the examined programming object. You must LOAD the inspector before you use it in your code.
1 Like
I donāt think he can use this as condition as @dan11 wrote above
So we have to expect direct formatting and maybe a bunch of auto-created styles from conversion.
.
Ctrl-M could be used for cleanup, if we assume āthere is no important formatting inside the cells, endangered to be lost.ā
1 Like
Please, do not use (and do not advise using) ImplementationName in your code. Ever. This property (actually, getImplementationName function) value is not guaranteed to be stable. Additionally, an implementation name tells you nothing about what it supports - and the mapping of an implementation name to supported methods is only in a programmerās head.
If you need to know what you deal with, do it correctly: you need to call a method of an interface ā either check if this interface is implemented, directly using HasUnoInterfaces function (this function is specific to Basic, using introspection internally); or check if a service is supported, that includes the needed interface - using XServiceInfo::supportsService method - this is the UNO objectās own method, so portable to other programming languages. And the mapping from services to interfaces, and from interfaces to methods is documented in the API, and guaranteed to be stable.
2 Likes
I am trying to remember it (and use it) in the future. 
Here is the modified code:
REM ***** BASIC *****
option explicit
Sub findAndUnderline
Dim oCurrSel as object
Dim oRange as object
Dim sTarget As String
Dim selIndex as integer
sTarget = InputBox ("Search phrase")
oCurrSel = ThisComponent.CurrentSelection
' xray oCurrSel
if oCurrSel.supportsService("com.sun.star.sheet.SheetCellRanges") then
Print "Some Ranges are selected"
For selIndex = 0 to oCurrSel.getCount() - 1
oRange = oCurrSel.getByIndex(selIndex)
MarkStrings(oRange, sTarget)
Next
end if
if oCurrSel.supportsService("com.sun.star.sheet.SheetCellRange") then
Print "One Range is selected"
oRange = oCurrSel
MarkStrings(oRange, sTarget)
end if
if oCurrSel.supportsService("com.sun.star.sheet.SheetCell") then
Print "One Cell is selected"
oRange = oCurrSel
MarkStrings(oRange, sTarget)
end if
End Sub
Sub MarkStrings(oOneRange as object, sText as string)
Dim oCell as object
dim tc as object
Dim i, j, start, pos as integer
For i = 0 To oOneRange.Rows.getCount() - 1
For j = 0 To oOneRange.Columns.getCount() - 1
oCell = oOneRange.getCellByPosition( j, i )
REM https://stackoverflow.com/questions/35239915/find-all-strings-within-a-string
start = 1
Do
pos = InStr(start, oCell.String, sText)
If pos > 0 Then
start = pos + 1
tc = oCell.CreateTextCursorByRange(oCell.Start)
tc.goRight(pos - 1, False)
tc.goRight(Len(sText), True)
tc.CharUnderline = 2
End If
Loop While pos > 0
Next
Next
End Sub
2 Likes
Two other things that may be worth noting:
- Similar functionality could be also somewhat achieved with Calcās builtin āFind and Replaceā tool (as explained recently in the other thread) with the added benefit of undoing the action with a single press of ctrl+z (current script requires you to undo changes for each occurrence of a keyword separately). This script however also formats the sought keyword, which I think makes it stand out more (YMMV).
- Final use case: If you assign this script to a keybinding (I chose Shift+Alt+F) you can start the search for a keyword on the sheet (Ctrl+F) to select the first cell, close the search tool (Esc) and press the new keybinding (Shift+Alt+F) to highlight the keyword within that cell. If you havenāt found it undo the changes (press Ctrl+Z a few times) and search for the next cell with your keyword (press Ctrl+Shfit+F - no need to open the āFindā tool again). Run the script again on the next cell (Shift+Alt+F). Repeat the last two steps until you found what you were looking for. There are other ways to go about it, but this worked for me.
3*. Also I found tc.CharBackColor = 255 instead of tc.CharUnderline = 2 (on line 50) stand out a bit more. It has a downside though that to undo it you will need to press Ctrl+Z twice.
Meanwhile the question has internally and externally split up in many questions.
Let me name this variant āfind cells containing text, find this text also inside the found cells, and apply a character attribute to those findings (without changing previously set attribution)ā.
I now present a preliminary solution to this āmissionā. It is obviously incomplete but I wonāt use the solution myself, and Iām not on the way to make it pretty for selling. To the contrary I consider to retire from this complex. Let spreadsheets be spreadsheets is good advice though often disregarded.
One more thing: The solution contains a few rather matured parts from my personal Standard library. Thatās public domain as everything made by me, but I would ask you, to NOT SPREAD REWORKED versions without taking full responsibility (and possibly inform me).
searchIntoCellsDinosaurs_sampleB.ods (27.8 KB)
There was a bug resulting in an error. The version attached below has a workaround for it.
searchIntoCellsDinosaurs_sampleCwithWorkaround.ods (27.7 KB)
2 Likes
Greetings to @JohnSUN. You surely will find a better and more complete solution.
I consider your remark that we share a similar spirit to be high praise.
However, I cannot keep up in many respects.
May peace embrace your life again.
2 Likes
Thank you very much for sharing. I just tried to run it by opening the attached macros directly and got an error below - is it expected or should it be executed in another way?
Sorry. I really dislike images in such cases. Lot of area, no use. If you claim a called macro didnāt work, first name the one you tried to run, and tell how you prepared for it, and at what point it failed with what message or effect.
The only macro in the example that makes sense if called directly is findCellsSetAttributesInsideForFindings It has three parameters all declared Optional just for the demo. What default values are used for them you find in the first few lines of the code. (You donāt necessarily need to understand the second and the third one from the beginning.)
Clearly you need to understand that the macro takes the CurrentSelection as the SheetCellRanges it will work for. If this is restricted to ranges without any match I expected the fRgs result to be a SheetCellRanges object with .Count=0. This was the reasonable expectation, but actually a NULL object is returned in that case. The .findAll() is not specified this way.
Well any complex software (like LibreOffice or its API) in the world is buggy, and I will not know every possible bug in advance. If you actually want to work with macros and the API, you need to use the tools of the IDE (and probably MRI) to find errors (bugs?) and to repair them.
In this single case I will now insert a workaround for the bug into the code and attach the updated version. Be sure to understand that you never can get sulutions of the kind with any warranty.
See tdf#155822 .
searchIntoCellsDinosaurs_sampleCwithWorkaround.ods (27.7 KB)
searchIntoCellsDinosaurs_sampleDwithUpdatedWorkaround.ods (28.4 KB)
The previouis upload contained an error.
1 Like
My bad, it is working fine - I didnāt know that cursor position in the editor fires different parts of the code. Once moved to the findCellsSetAttributesInsideForFindings subroutine it worked correctly.
Not sure if this solution is much better than the one you suggested.
[Pinscher-L-0.6.25.oxt] (The link to the pre-release version has been removed - who would need a program with bugs?! The corrected version can be downloaded four posts below)
This extension adds a button to the āFindā panel (Ctrl+F) to display all the specified pieces of text (āpinchā) in the cells of the active Calc sheet.
First of all: Thanks to @JohnSUN for the thorough examination of the suggested code contained my above example: It contained a really annoying typo in line 8 of the main Sub.
I will soon upload a rectified version.
The missing dialogs (or InputBox-es) I leave still to the caller somebody wanting to apply the solution may write himself.
We missed you for some days now, and we are happy that you seem to be well. Thatās something we should appreciate when said about a Kiiw inhabitant these days.
You created a professional solution and made an oxt-extension of it. Great!
However, we will need a 0.6.26:
The dialog button for āGoto subsequent cellā has no tooltip.
No excuses, please!
In addition, the line
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("MRILib")) Then GlobalScope.BasicLibraries.LoadLibrary("MRILib")
in Sub initExtension will cause an error for anyone who has not yet installed MRI.
Why is .OXT not included in the list of files that can be attached to an answer here? Itās not as hard to make an extension as it is to publish itā¦
BTW: I was too lazy to thoroughly study in what way you possibly use MRI.
Especially for those who do not like to read instructions - a boring video YouTube. Donāt forget to turn on the subtitles and translate them into German.
Pinscher-L-0.6.26.oxt.bmp (93.2 KB)
Of course, this is not a BMP, the file must be renamed after downloading
