No obstante, desde hace varios días me he atascado en uno de los pasos que son fundamentales para mi trabajo y es pasar la información de Base a Writer. Lo he conseguido hacer desde Writer, conectando la plantilla a mi base de datos de una forma bastante sencilla, pero mi idea es que esta combinación se haga directamente desde Base como lo hacía desde Access.
Estoy cerca de hacerlo gracias al post de Longi (https://forum.openoffice.org/es/forum/v ... odt#p48049) ya que he conseguido que desde mi formulario de Base y a través de Mail Merge me enlace mi plantilla de Writer con mi tabla de Base. Pero el problema es que me enlaza todos los registros de mi base de datos, que son al menos 100, por lo que me genera un documento con 1.000 páginas y yo solo quiero que me enlace uno de mis registros, el que yo le diga o que la aplicación me pregunte que registro usar a través del campo número de factura, por ejemplo.
Por ello, necesito modificar dicha Macro para que me filtre por el campo que yo le diga, por ejemplo, el campo número de factura.
Esta es la macro de Longi
Código: Seleccionar todo
Sub MailMerge ()
' Adaptado de Xabin
'---------------------------------------------------------------
' 1º Declaramos las variables
Dim noOpt() As Object, oText As Variant, oCurs As Object, RDescrip As Variant
Dim sRuta As String, oRuta As String, dRuta As String, LineSpace As Variant
Dim mOpciones(0) As New "com.sun.star.beans.PropertyValue"
Dim oDoc As Object, objMailMerge As Object
Dim document as object, dispatcher as object
'-------------------------------------------------------------------
' 2º Determinamos las rutas que nos interesan
oRuta= convertToURL("Ruta del documento que tiene la combinación de campos")
dRuta= ConvertToURL("Ruta de la carpeta en la que se encuentra el documento que guardamos ya combinado")
'---------------------------------------------------------------------------------
' 3º Nos aseguramos de no tener más de un documento
If FileExists(dRuta + "/temp0.odt") Then ' Si existe el documento
kill dRuta + "/temp0.odt" ' Lo eliminamos
End If ' Acabamos la condición
'-------------------------------------------------------------------------------------
' 4º Establecemos el origen de datos y creamos el servicio
objMailMerge = createUnoService("com.sun.star.text.MailMerge") ' Creamos el servicio
objMailMerge.DataSourceName = "Mi base de datos" ' El nombre de la base de datos
objMailMerge.DocumentURL = oRuta ' Ruta del documento que tiene la combinación de campos
objMailMerge.CommandType = 0 ' 0= Tabla, 1=Consulta
objMailMerge.Command = "Mi tabla" ' Nombre de la tabla que coincide con el nombre de la base de datos
objMailMerge.OutputType = 2 ' 2= FILE, 1 = PRINTER, 3 = EMAIL
objMailMerge.OutputURL = dRuta ' Ruta de la carpeta en la que se encuentra el documento que guardamos
objMailMerge.FileNameFromColumn = False
objMailMerge.SaveAsSingleFile = True
objMailMerge.FileNamePrefix = "temp" ' Prefijo que utilizamos para el nombre del archivo temporal
'------------------------------------------------------------------------
' 5º Se ejcuta la combinación de correspondencia
objMailMerge.execute(noOpt) ' Se combinan los nuevos datos
oDoc = StarDesktop.loadComponentFromURL( dRuta &"/temp0.odt", "_blank", 0, mOpciones() )' Se abre el documento ya combinado
'-------------------------------------------------------------------------
' 6º Editamos el texto
oText = oDoc.GetText() ' Texto del documento de Writer
oCurs = oText.createTextCursor() ' Creamos un cursor de texto
oCurs.gotoEND(True) ' Cursor va al final del texto
LineSpace = oCurs.paralinespacing
LineSpace.height = 150 ' Establecemos un interlineado de 1,5
oCurs.paralinespacing = LineSpace
oCurs.ParaAdjust = com.sun.star.style.ParagraphAdjust.BLOCK ' Establece justificación en todo el documento como un bloque
'------------------------------------------------------------------------
' 7º Este apartado solo funciona en OpenOffice, en LibreOffice es un bug y lo solucionamos en el siguiente paso:
RDescrip = oDoc.createReplaceDescriptor ' Elemento que usaremos para sustituir partes del texto
RDescrip.searchRegularExpression = True ' Sustituiremos expresiones regulares
RDescrip.searchString = "\n" ' Buscamos los intros
RDescrip.replaceString ="\n" ' Los sustituimos por un quiebre de párrafo
oDoc.replaceAll(RDescrip) ' Ejecutamos el reemplazo
'--------------------------------------------------------------------------
' 8º Este paso vale tanto para libre como para Openoffice, grabado con la grabadora de macros de Writer:
rem get access to the document
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
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 = "\n"
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = "\n"
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 = 3
args1(18).Name = "Quiet"
args1(18).Value = true
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
End Sub
Editado: Por RMG, cambio de título a minúsculas, según indican las normas del foro.