Llevaba tiempo intentando encontrar la forma de que al realizar una búsqueda en Calc, está ignorara los signos de acentuación, y me encontré el siguiente tema:
https://forum.openoffice.org/es/forum/v ... =17&t=9821
que nos lleva a la siguiente página:
https://blog.open-office.es/basic/cuestion-de-acentos
Increible el trabajazo que hicieron, así que me puse a intentar adaptar el código para que funcionara en LibreOffice Calc, pero no he sido capaz...
¿Me podéis echar una mano para conseguir una macro similar que funcione en Calc?
La macro funciona a la perfección en Writer, abriendo un textbox para insertar la palabra que queremos buscar, y como resultado nos señala todas las palabras, con o sin acentos en el texto. La idea sería que o bien nos señale todo, o bien nos lleve a la siguiente palabra que cumpla con esos requisitos, sin tener en cuenta las tildes.
El código original de la macro creada en las páginas citadas para Writer es el siguiente:
Código: Seleccionar todo
REM ***** BASIC *****
Sub BuscaConSinTildesWriter()
' Busca la primera o todas las palabras que contiene cualquier tipo de coincidencia con las mismas vocales y cualquier tilde o sin ella
' Tilde == Acento
Dim LoQueBusco As String, BuscarC As String
Dim n As Long, c As String
Dim Primero_o_Todos As Integer
LoQueBusco=InputBox( "Teclea la palabra a BuscarC", "BuscarC con o sin tildes")
If LoQueBusco="" Then Exit Sub
Primero_o_Todos = 1 ' BuscarC todos = 1, BuscarC el primero = 0
For n=1 To Len(LoQueBusco)
c = Mid(LCase(LoQueBusco),n,1)
Select Case c
Case "a","á","à","â","ä","ã", "å", "ă","ā","ą","ǎ" '
BuscarC = BuscarC & "[aáàâäãåăāąǎAÁÀÂÄÃÅĂĀĄ]"
Case "e","é","è","ê","ë","ē","ę","ě"
BuscarC = BuscarC & "[eéèêëēęěEÉÈÊËĒĘ]"
Case "i","í","ì","î","ï","ī","ǐ"
BuscarC = BuscarC & "[iíìîïīǐIÍÌÎÏĪ]"
Case "o","ó","ò","ô","ö", "õ", "ő","ō","ǒ"
BuscarC = BuscarC & "[oóòôöõőōǒOÓÒÔÖÕŐŌ]"
Case "u","ú","ù","û","ü","ŭ","ű","ū","ǔ","ǖ","ǘ","ǚ","ǜ"
BuscarC = BuscarC & "[uúùûüŭűūǔǖǘǚǜUÚÙÛÜŬŰŪ]"
Case "y","ý","ÿ"
BuscarC = BuscarC & "[yýÿYÝŸ]"
Case "n","ñ"
BuscarC = BuscarC & "[nñNÑ]"
Case "c","ç"
BuscarC = BuscarC & "[cçCÇ]"
Case Else
BuscarC = BuscarC & c
End Select
Next
BuscaEnTexto( BuscarC, Primero_o_Todos )
End Sub
Sub BuscaEnTexto( BuscarC, Primero_o_Todos )
' Creada con la grabadora y adaptada para éste propósito
Dim document As Object
Dim dispatcher As Object
document = ThisComponent.CurrentController.Frame
dispatcher = CreateUNOService("com.sun.star.frame.DispatchHelper")
Dim args1(18) As New com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = True
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = False
args1(4).Name = "SearchItem.Backward"
args1(4).Value = False
args1(5).Name = "SearchItem.Pattern"
args1(5).Value = False
args1(6).Name = "SearchItem.Content"
args1(6).Value = False
args1(7).Name = "SearchItem.AsianOptions"
args1(7).Value = False
args1(8).Name = "SearchItem.AlgorithmType"
args1(8).Value = 1
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 65536
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = BuscarC
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = ""
args1(12).Name = "SearchItem.Locale"
args1(12).Value = 255
args1(13).Name = "SearchItem.ChangedChars"
args1(13).Value = 2
args1(14).Name = "SearchItem.DeletedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.InsertedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.TransliterateFlags"
args1(16).Value = 1280
args1(17).Name = "SearchItem.Command"
args1(17).Value = Primero_o_Todos
args1(18).Name = "Quiet"
args1(18).Value = True
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
End Sub
Un saludo.
P.D. No creo que influya, pero uso LibreOffice 7.0.2