Función llamada a Writer para insertar una imagen desde MS Access VBA

Hola,

necesito código visual basic de Access que haga una llamada a Writer, abra un documento .odt y en un punto concreto insertar una imagen. El punto donde insertar la imagen podría estar marcado como {IMAGEN} (o algo parecido).

La función pasaría dos parámetros, la ruta de la plantilla y la ruta de la foto.

Adjunto un código de ejemplo (de Libre BASIC) que he encontrado en un foro para hacer algo parecido. Inserta varias imágenes.

Me interesa en especial la “traducción” a VBA de las definiciones de los objetos FRAME y DISPATCHER y cómo hacer las llamadas.

==========
[ Preformatted text
Sub BuscarImagen
SDescrip = ThisComponent.createSearchDescriptor()
SDescrip.SearchRegularExpression = TRUE
SDescrip.SearchString = “{IMAGEN}”

Frame = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(“com.sun.star.frame.DispatchHelper”)

rem ----------------------------------------------------------------------
dim args1(3) as new com.sun.star.beans.PropertyValue
args1(0).Name = “FileName”
'args1(0).Value = “”
args1(1).Name = “FilterName”
args1(1).Value = “”
args1(2).Name = “AsLink”
args1(2).Value = false
args1(3).Name = “Style”
args1(3).Value = “Imágenes”

oVC = ThisComponent.CurrentController.ViewCursor

Imagenes = ThisComponent.findAll(SDescrip)
Count = Imagenes.Count

for i = 0 to Count - 1
oTexto = Imagenes.getByIndex(i)
oVC.gotoRange(oTexto.Start, False)
NumCarac = Len(oTexto.String)
NombreImagen = Right(oTexto.String, NumCarac - 2)
oTexto.String = “”
args1(0).Value = convertToURL("/home/fjcc/Desktop/EJEMPLOS/IMAGENES/" & NombreImagen & “.PNG”)

dispatcher.executeDispatch(Frame, “.uno:InsertGraphic”, “”, 0, args1())
oVC.jumpToStartOfPage()

next i
End Sub

]

Estimo que deberías consultar en un sitio de Microsoft o Access, este es un sitio de LibreOffice que no guarda relación alguna con los mencionados.

Disculpad la “intromisión” pero los que conocéis bien los métodos y propiedades de LibreOffice estáis aquí. Aunque tenga que alterar un poco la forma de hacer las llamadas desde VBA, es más fácil encontrar aquí la solución. De hecho ya hay un partipante que me está ayudando. Siento las molestias.

Como paso previo a dar el salto a LibreOffice Base, pretendo adaptar mis aplicaciones para que operen con Writer en lugar de con Word, y así poder entregar un distribuible que no necesitaría licencia en la máquina del cliente, únicamente el Runtime de Access y LibreOffice. De momento es lo más urgente. Después ya iré poco a poco desarrollando en Base.

Lo primero que tienes que validar, es si puedes crear el objeto correspondiente para comunicarte con LibreOffice, pruebalo con:

Dim arg()

Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oDesktop = oSM.createInstance("com.sun.star.frame.Desktop")

Set doc = oDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, arg)

MsgBox doc.Title

Si funciona, entonces, ya puedes crear la instancia que necesitas.

dispatcher = oSM.createInstance(“com.sun.star.frame.DispatchHelper”)

El punto más importante, es que “sepas”, que VBA “no conocerá” los objetos y método de LibreOffice Basic, casi todo debes de referenciarlo con oSM.createInstance, por ejemplo, no esperes que esto funcione desde VBA

dim args1(3) as new com.sun.star.beans.PropertyValue

Aquí, te pongo un ejemplo para una sola propiedad, generalmente debes de usarla como matriz.

Set oPropertyValue = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")

Muchas gracias por tu ayuda. Te pongo el código modificado, consigo abrir una plantilla, hago una sustitución de texto, exporto a pdf. Hasta aquí bien. Debajo de cada línea que da error lo pongo comentado, por si me puedes ofrecer nuevas pistas. Efectivamente, como Access no conoce los métodos de LibreOffice (ni yo tampoco porque estoy empezando ahora) el mensaje de error que devuelve no me aclara nada. ¿cómo podría insertar una foto en el texto?

Public Sub insertaJpg_ODT()   '    INSERTA IMÁGENES EN ODT
 Dim doc As Object
 Dim strDoc As String
 Dim oSM As Object
 Dim oDesktop As Object
 Dim oDoc As Object
 Dim oDispatcher As Object
 Dim oArgs(0) As Object
 Dim oProp(1) As Object
     
 On Error GoTo Error_insertajpg
 strDoc = "C:\temp\plantilla1.odt"
 strDoc = Replace(strFinalDoc, "\", "/")
 strDoc = "file:///" + strDoc
 
 strPDF = "C:\temp\plantilla1.pdf"
 strPDF = Replace(strPDF, "\", "/")
 strPDF = "file:///" + strPDF
     


 Set oSM = CreateObject("com.sun.star.ServiceManager")
 Set oDesktop = oSM.createInstance("com.sun.star.frame.Desktop")
 
 Set oArgs(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 oArgs(0).Name = "Hidden"
 oArgs(0).Value = True
 
 'Set oDoc = oDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oArgs())
 ' abre documento nuevo
 
 Set oDoc = oDesktop.loadComponentFromURL(strDoc, "_blank", 0, oArgs())  ' abre plantilla existente
 
 Call oDoc.getCurrentController.getFrame.getContainerWindow.setVisible(True)
 MsgBox oDoc.Title
 
 'Si funciona, entonces, ya puedes crear la instancia que necesitas.

 ' oDispatcher = createInstance(“com.sun.star.frame.DispatchHelper”)
 
 ' La línea anterior da error. No llega a ejecutar la subrutina
 ' advierte que no se ha definido Sub o Function
 ' en referencia a createInstance  , precisamente por lo que dices, que VB no conoce los métodos de LibreOffice
 ' pruebo anteponiendo a createInstance   oSM. por similitud con la definición de set oDoc
 ' Error 424 : SE REQUIERE UN OBJETO

  
  Set mibusqueda = oDoc.createReplaceDescriptor
  mibusqueda.setsearchstring ("{CAMPO1}")
  mibusqueda.setreplacestring ("SUSTITUCIÓN HECHA")
  Call oDoc.replaceall(mibusqueda)
  
  ' sustitución de un campo por un texto. funciona perfectamente
  

  '=======   prueba insertar imagen  , aquí es donde falla
    

 Set oProp(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 Set oProp(1) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 oProp(0).Name = "FileName"
 oProp(0).Value = "file:///c:/temp/pruebas/tmp-001.jpeg"   ' "file:///<YOURPATH>/<YOURFILE>"
 oProp(1).Name = "AsLink"
 oProp(1).Value = False
 
  ' Set oDispatcher = oSM.createUnoService("com.sun.star.frame.DispatchHelper")
  ' ERROR 438 EL OBJETO NO ADMITE ESTA PROPIEDAD O MÉTODO
 
 Set oDispatcher = oSM.createInstance("com.sun.star.frame.DispatchHelper")
 Call oDispatcher.executeDispatch(oDoc, ".uno:InsertGraphic", "", 0, oProp())
 ' ERROR: no coinciden los tipos

 
 'Call document.storeasURL(strFichDestino, oArgs())   'graba con otro nombre
    
 oArgs(0).Name = "FilterName"
 oArgs(0).Value = "writer_pdf_Export"
 Call oDoc.storeToURL(strPDF, oArgs())   'oDoc.storeToURL( sRuta, mOpciones()


 Call oDoc.Close(True) 'Cerramos el archivo
    
 Exit Sub
   
Error_insertajpg:

   Beep
    'MsgBox "Ha ocurrido el error:" & vbCrLf &
    'Err.Description , vbCritical, "OLE Error!"
    Resume Next
   Exit Sub
     



End Sub

Copiaste mal la instrucción, yo puse:

dispatcher = oSM.createInstance(“com.sun.star.frame.DispatchHelper”)

y pones

oDispatcher = createInstance(“com.sun.star.frame.DispatchHelper”)

más abajo la usas correctamente

Set oDispatcher = oSM.createInstance("com.sun.star.frame.DispatchHelper")

El método executeDispatch, requiere que le pases un frame y le estas pasando el documento. Asumiento que lo demás esta correcto, entonces es:

Set frame = oDoc.CurrentController.Frame
oDispatcher.executeDispatch(frame, ".uno:InsertGraphic", "", 0, oProp())
1 Like

Perfecto. Muchísimas gracias. Ahora haré pruebas para ver si soy capaz de colocar la imagen ( o imágenes ) en puntos concretos que tenga marcados previamente en la plantilla, pero doy por solucionado este hilo. Muchas gracias por tu tiempo.
Pongo de nuevo el código (Access VBA) corregido , que abre una plantilla, sustituye una marca entre llaves {CAMPO1} por otro texto, inserta una imagen para después exportar todo a un fichero .pdf

Public Sub insertaJpg_ODT()   '    INSERTA IMÁGENES EN ODT
 Dim doc As Object
 Dim strDoc As String
 Dim oSM As Object
 Dim oDesktop As Object
 Dim oDoc As Object
 Dim oDispatcher As Object
 Dim oFrame As Object
 Dim oArgs(0) As Object
 Dim oProp(1) As Object
     
 On Error GoTo Error_insertajpg
 strDoc = "C:\temp\pruebas\plantilla1.odt"
 strDoc = Replace(strDoc, "\", "/")
 strDoc = "file:///" + strDoc
 
 strPDF = "C:\temp\pruebas\plantilla1.pdf"
 strPDF = Replace(strPDF, "\", "/")
 strPDF = "file:///" + strPDF
     


 Set oSM = CreateObject("com.sun.star.ServiceManager")
 Set oDesktop = oSM.createInstance("com.sun.star.frame.Desktop")
 
 Set oArgs(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 oArgs(0).Name = "Hidden"
 oArgs(0).Value = True
 
 ' Set oDoc = oDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oArgs())
 ' abre documento nuevo, sustituyo la llamada por una que abre un documento concreto
 
 Set oDoc = oDesktop.loadComponentFromURL(strDoc, "_blank", 0, oArgs())  ' abre plantilla en variable strDoc
 
  
 Set oFrame = oDoc.CurrentController.Frame
 
 Set oDispatcher = oSM.createInstance("com.sun.star.frame.DispatchHelper")
 
 Call oDoc.getCurrentController.getFrame.getContainerWindow.setVisible(True)
 ' MsgBox oDoc.Title
 
  
  Set mibusqueda = oDoc.createReplaceDescriptor
  mibusqueda.setsearchstring ("{CAMPO1}")
  mibusqueda.setreplacestring ("SUSTITUCIÓN HECHA")
  Call oDoc.replaceall(mibusqueda)
  
  ' sustitución de un campo por un texto. funciona perfectamente
  

 Set oProp(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 Set oProp(1) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
 oProp(0).Name = "FileName"
 oProp(0).Value = "file:///c:/temp/pruebas/tmp-001.jpeg"   ' "file:///<YOURPATH>/<YOURFILE>"
 oProp(1).Name = "AsLink"
 oProp(1).Value = False
 
 Set oFrame = oDoc.CurrentController.Frame
 
 Set oDispatcher = oSM.createInstance("com.sun.star.frame.DispatchHelper")
 Call oDispatcher.executeDispatch(oFrame, ".uno:InsertGraphic", "", 0, oProp())
 
 'Call document.storeasURL(strFichDestino, oArgs())   'graba con otro nombre
    
 oArgs(0).Name = "FilterName"
 oArgs(0).Value = "writer_pdf_Export"
 Call oDoc.storeToURL(strPDF, oArgs())   'exporta aPDF

 Call oDoc.Close(True) 'Cerramos el archivo
    
 Exit Sub
   
Error_insertajpg:

   Beep
   MsgBox "Ha ocurrido el error:" & vbCrLf & Err.Description, vbCritical, "OLE Error!"
   Resume Next
   Exit Sub
     
End Sub