@KamilLanda @JohnSUN
Thank you so much guys! This is almost exactly what I need! KamilLanda, your solution works perfectly for selecting cells, and I also appreciate the additions JohnSUN added for searching selected text and not having an error pop up unnecessarily.
The ONLY issue I have found is that JohnSUN’s code does not work with merged cells. (EDIT: Fixed! See below!) I looked at the code and I just don’t know the language at all so I’m not sure how to fix it, but I would assume it has something to do with the way it avoids either the multiple cell error message or searching for empty cells. I’m sure it’s an easy fix.
If for some reason that isn’t possible to fix, then it would be fine to just go back to having an error pop up, but I would like to keep the text searching part.
There is, of course, also the possibility that I didn’t put the two bits of code together properly, so here is what I am using which is almost perfect but has trouble with merged cells:
Sub FindAll
Dim oDoc As Object, oSheet As Object, oDesc As Object, s$, oFound As Object
oDoc=ThisComponent
If oDoc.getCurrentSelection().supportsService("com.sun.star.sheet.SheetCell") Then
oSheet=oDoc.CurrentController.getActiveSheet
uno("Copy") 'copy selection to system clipboard
uno("Cancel") 'cancel edit mode if needed
s=getTextFromClipboard 'get text from system clipboard
If s <> "" Then ' We will not look for empty cells
oDesc=oSheet.createSearchDescriptor 'search descriptor
oDesc.setSearchString(s)
oFound=oSheet.findAll(oDesc) 'Find All
oDoc.CurrentController.Select(oFound) 'select found items
EndIf
EndIf
End Sub
Function getTextFromClipboard() as string 'get String from system clipboard
dim oClip, oConv, oCont, oTyps, i%
oClip=CreateUNOService("com.sun.star.datatransfer.clipboard.SystemClipboard")
oConv=CreateUNOService("com.sun.star.script.Converter")
oCont=oClip.getContents()
oTyps=oCont.getTransferDataFlavors()
On Error Resume Next
for i=lbound(oTyps) to ubound(oTyps)
if oTyps(i).MimeType="text/plain;charset=utf-16" then
getTextFromClipboard=oConv.convertToSimpleType(oCont.getTransferData(oTyps(i)), com.sun.star.uno.TypeClass.STRING)
exit for
end if
next
On Error GoTo 0
End Function
Sub uno(s$, optional oDoc as object) 'simple UNO command
if isMissing(oDoc) then oDoc=thisComponent
dim document, dispatcher
s=".uno:" & s
document=oDoc.CurrentController.Frame
dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, s, "", 0, array())
End Sub
(I’m not sure why the Sub uno section is mostly in bold when I paste it. It isn’t that way when I copy it?)
Thank you all for your time!
EDIT: OH wow! I think I fixed it… I just changed:
"com.sun.star.sheet.SheetCell")
to
"com.sun.star.sheet.SheetCellRange")
And now it works on merged cells as well!
Do you guys foresee any problems with this?
The only issues I have noticed are very minor. With any of these macros it will also select cells that contain the search terms and other characters… hard to explain. For example: search for “Bob”, highlights cells that contain “Bob” and cells that contain “Bobby”. This isn’t a huge problem for my specific use case right now, but it may be in other instances as I plan to use this for different types of sheets I work with.
Also, when I did the CellRange search it has slightly odd behavior in that if the cell I’m clicking on to initiate the search is the ONLY cell that contains that data, it will highlight half of the cell. This is very minor and doesn’t really affect anything. It just looks odd. Not a big deal.
