¡Hola a todos!
Espero que estén bien. Estoy buscando ayuda con una macro en LibreOffice que actualmente uso para copiar textos seleccionados a través de checkboxes, como se muestra en la imagen adjunta. La macro necesita ser modificada para manejar textos más largos que incluyen varios párrafos y recuadros, ya que no procesa correctamente estos elementos en su forma actual.
¿Alguien podría orientarme sobre cómo adaptar esta macro para que maneje adecuadamente textos más complejos? No tengo experiencia con macros, por lo que cualquier consejo sería enormemente útil.
¡Gracias de antemano por su tiempo y ayuda!
Aquí abajo dejo mi código:
Saludos
`Option Explicit
Sub BtEjecutar_Clic( oEv )
'-------------------------------------------------------------------------------------------
Dim n As Integer, lIntros As Boolean
Dim Form As Object, Ctrl As Object
Dim mArg(), NuevoDoc As Object
Dim DocOrg As Object, DocDst As Object
Dim Terminar As Boolean
Form = ThisComponent.Drawpage.Forms.GetByIndex(0)
' Compruebo que al menos hay una opción activada
Terminar = True
For n=1 To 21
Ctrl = Form.GetByName("CV" & n)
If Ctrl.State = 1 Then
Terminar = False
EndIf
Next
If Terminar Then
Beep
MsgBox ("No se ha seleccionado ningún bloque", 192, "LibreOffice.es")
Else
DocOrg = ThisComponent.CurrentController.Frame
DocDst = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_default", 0, mArg() )
DocDst = DocDst.CurrentController.Frame
lIntros = Form.Intros.State = 1
For n=1 To 21
Ctrl = Form.GetByName("CV" & n)
If Ctrl.State = 1 Then
CopiarTexto( DocOrg, "Texto " & n )
PegarTexto( DocDst, lIntros )
Ctrl.State = 0
EndIf
Next
DocDst.ContainerWindow.toFront()
DocDst.ContainerWindow.SetFocus()
Beep
MsgBox ("Proceso terminado", 192, "open-office.es")
EndIf
End Sub
Sub CopiarTexto( Doc As Object, cBloque As String )
'-------------------------------------------------------------------------------------------
Doc.ContainerWindow.toFront()
Doc.ContainerWindow.setFocus()
Dim dispatcher As Object
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 = 0
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 65552
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = cBloque
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 = 0
args1(18).Name = "Quiet"
args1(18).Value = True
dispatcher.ExecuteDispatch(Doc, ".uno:ExecuteSearch", "", 0, args1())
Dim args2(1) As New com.sun.star.beans.PropertyValue
args2(0).Name = "Count"
args2(0).Value = 1
args2(1).Name = "Select"
args2(1).Value = False
dispatcher.ExecuteDispatch(Doc, ".uno:GoRight", "", 0, args2())
dispatcher.ExecuteDispatch(Doc, ".uno:EndOfParaSel", "", 0, Array())
dispatcher.ExecuteDispatch(Doc, ".uno:Copy", "", 0, Array())
dispatcher.ExecuteDispatch(Doc, ".uno:GoToStartOfDoc", "", 0, Array())
End Sub
Sub PegarTexto( Doc As Object, lExtraIntros As Boolean )
'-------------------------------------------------------------------------------------------
Dim dispatcher As Object
dispatcher = CreateUNOService("com.sun.star.frame.DispatchHelper")
dispatcher.ExecuteDispatch(Doc, ".uno:GoToEndOfDoc", "", 0, Array())
dispatcher.ExecuteDispatch(Doc, ".uno:Paste", "", 0, Array())
dispatcher.ExecuteDispatch(Doc, ".uno:InsertPara", "", 0, Array())
If lExtraIntros Then dispatcher.ExecuteDispatch(Doc, ".uno:InsertPara", "", 0, Array())
dispatcher.ExecuteDispatch(Doc, ".uno:GoToStartOfDoc", "", 0, Array())
End Sub`
