Buenos días, he estado buscando en el foro antes de postear por si a alguien le ocurría lo mismo que a mi y no he encontrado nada así que me disculpo por si estoy equivocada y no he ojeado bien los temas.
Resulta que necesito insertar una imagen en una celda de una hoja de Calc de OpenOffice y realmente no se como hacerlo, probé con el código de tu libro pero es para una Macro y da error en un proyecto de VB 6:
Function getImagen(RutaImagen As String) As Object
Dim oDoc As Object
Dim oPaginaDibujo As Object
Dim oImagen As Object
oDoc = ThisComponent
oPaginaDibujo = oDoc.getCurrentController.getActiveSheet.getDrawPage()
oImagen = oDoc.createInstance( "com.sun.star.drawing.GraphicObjectShape" )
oImagen.GraphicURL = RutaImagen
oPaginaDibujo.add( oImagen )
getImagen = oImagen
End Function
Sub Imagenes5()
Dim sRuta As String
Dim oImagen As Object
Dim oTam As New com.sun.star.awt.Size
sRuta = SelecionarImagen()
If sRuta <> "" Then
oImagen = getImagen( sRuta )
oTam.Width = 10000
oTam.Height = 7500
oImagen.setSize( oTam )
End If
End Sub
El error me da en "ThisComponent", no está declarado . ¿Alguien podría orientarme un poco? Iré comentando los cambios que vaya realizando y si lo resuelvo.
Sub InsertarImagen()
Dim args()
Set ServiceManager = CreateObject("com.sun.star.ServiceManager")
Set Desktop = ServiceManager.createInstance("com.sun.star.frame.Desktop")
Set Document = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args) 'crear un documento
Ruta = "file:///c:/imagen.jpg"
Set oImagen = getImagen(Document, Ruta)
Set oTam = ServiceManager.Bridge_GetStruct("com.sun.star.awt.Size")
oTam.Width = 10000
oTam.Height = 7500
oImagen.setSize (oTam)
End Sub
Function getImagen(oDoc, Ruta) As Object
Set oPaginaDibujo = oDoc.getCurrentController.getActiveSheet.getDrawpage()
Set oImagen = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oImagen.GraphicURL = Ruta
oPaginaDibujo.Add (oImagen)
Set getImagen = oImagen
End Function
FJCC-ES, te agradezco mucho la ayuda, me ha resultado muy útil pero me sigue dando un error en oPaginaDibujo.Add (oImagen) --> oPaginaDibujo no admite esa propiedad o método
P.D: Perdón por tardar en contestar pero he tenido una semana de vacaciones y estuve totalmente desconectada.
Recuerda que VB necesita "conocer" los objetos que intenta llamar, todos los objetos de OOo, VB no los "conoce", para "presentarlos", como ya te comento mi amigo, usas las líneas:
Set ServiceManager = CreateObject("com.sun.star.ServiceManager")
Set Desktop = ServiceManager.createInstance("com.sun.star.frame.Desktop")
Así, la función getImagen, "debes" de llamarla desde el procedimiento InsertarImagen, tal cual te lo muestra mi amigo. Muéstranos el código completo que estas usando para guiarte...
Saludos
______________________________________________
"Todo cuanto no podemos dar nos posee". - André Gide
LibreOffice 6.2 | ArchLinux | Gnome3 No respondo preguntas privadas, por favor, usa el foro
Estoy intentado insertar en una celda de una hoja de Calc de Oppenoffice, a traves de visual basic 6.0, lo consigo con los ejemplos que habeis dado aqui, pero si muevo el archivo de carpeta y los abro de nuevo la foto no aparece y en lugar a aparece el componenete con la ruta.
Bueno... lo que quiero saber es como se hace, guardar la imagen dentro del archivo en vez de guardar la ruta donde esta imagen, ya que si cambio alguno de sitio ya no se carga la imagen
Hola, estuve trabajando en una macro para pegar multiples imagenes (con W7 64bits no me ofrecía esa posibilidad) en un documento de word, y se pegaran anclada al caracter y ocupando todo el espacio que pudiera. Os dejo el código, por si os sirve (es un remix de varias fuentes, sobre todo del documento de Andrew para macros):
Sub MultiPictures
Dim oFileDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim sFiles
Dim InitPath as String
Dim oUcb as object
Dim filterNames(3) as String
Dim document as object
Dim oText
Dim oCurs
Dim FileURL
Dim objTextGraphicObject as object
Dim i, j,k as Integer
filterNames(0) = "*.*"
filterNames(1) = "*.png"
filterNames(2) = "*.jpg"
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.OfficeFilePicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFileDialog.setMultiSelectionMode(True)
AddFiltersToDialog(FilterNames(), oFileDialog)
InitPath = ConvertToUrl("C:\Pictures")
If oUcb.Exists(InitPath) Then
oFileDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFileDialog.Execute()
If iAccept = 1 Then
sFiles = oFileDialog.getFiles()
else
exit sub
End If
oFileDialog.Dispose()
document = ThisComponent
oText = ThisComponent.Text
Dim oVC
oVC = ThisComponent.getCurrentcontroller.getViewCursor
oCurs = oVC.getText.createTextCursorByRange(oVC)
oCurs.goRight(1,false)
Dim oBitmaps
Dim sInternalName$
oBitmaps = ThisComponent.createInstance("com.sun.star.drawing.BitmapTable")
for i = 1 to ubound(sFiles)
FileURL = sFiles(0) & sFiles(i)
sInternalName = LoadGraphicIntoDocument(ThisComponent, FileURL, sFiles(i))
InsertGraphicObject(ThisComponent, oCurs, sInternalName)
next
End Sub
Function LoadGraphicIntoDocument( oDoc As Object, cUrl$, cInternalName$ ) As String
Dim oBitmaps
Dim cNewUrl As String
Dim i as Integer
' Get the BitmapTable from this drawing document.
' It is a service that maintains a list of bitmaps that are internal
' to the document.
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
' Add an external graphic to the BitmapTable of this document.
on error resume next
oBitmaps.insertByName(cInternalName, cUrl)
cNewUrl = oBitmaps.getByName(cInternalName)
LoadGraphicIntoDocument = cNewUrl
End Function
Sub InsertGraphicObject(oDoc, oCursor, sURL$)
REM Author: Andrew Pitonyak
Dim oGraph
Dim oText
Dim oProps(0) as new com.sun.star.beans.PropertyValue
oProps(0).Name = "URL"
oProps(0).Value = sURL
oText = oDoc.getText()
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
Dim oSize100thMM
Dim lHeight As Long
Dim lWidth As Long
Dim oProvider 'GraphicProvider service.
oProvider = createUnoService("com.sun.star.graphic.GraphicProvider")
oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
If NOT IsNull(oSize100thMM) AND NOT IsEmpty(oSize100thMM) Then
lHeight = oSize100thMM.Height
lWidth = oSize100thMM.Width
End If
'oShape.Graphic = oProvider.queryGraphic(oProps())
'oGraph.graphicurl = oShape.graphicurl
oGraph.graphicURL = sURL
oGraph.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
If lHeight > 0 AND lWidth > 0 Then
Dim oSize
oSize = oGraph.Size
oSize.Height = lHeight
oSize.Width = lWidth
oGraph.Size = oSize
End If
'now insert the image into the text document
oText.insertTextContent( oCursor, oGraph, False )
End Sub
Function RecommendGraphSize(oGraph)
Dim oSize
Dim lMaxW As Double ' Maximum width in 100th mm
Dim lMaxH As Double ' Maximum height in 100th mm
Dim oVC
oVC = ThisComponent.getCurrentcontroller.getViewCursor
Dim pageDesc
pageDesc = oVC.PageStyleName
'pageDesc = oVC.ParaStyleName
Dim oStyle
oStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName(pageDesc)
lMaxW = oStyle.Width - oStyle.RightMargin -oStyle.LeftMargin - 2*oStyle.BorderDistance
lMaxH = oStyle.Height - oStyle.TopMargin - oStyle.BottomMargin - 2*oStyle.BorderDistance
if oStyle.HeaderIsOn then
lMaxH = lMaxH - oStyle.HeaderBodyDistance - oStyle.HeaderHeight
end if
if oStyle.FooterIsOn then
lMaxH = lMaxH - oStyle.FooterBodyDistance - oStyle.FooterHeight
end if
'lMaxW = 6.75 * 2540 ' 6.75 inches
' lMaxH = 9.5 * 2540 ' 9.5 inches
If IsNull(oGraph) OR IsEmpty(oGraph) Then
Exit Function
End If
oSize = oGraph.Size100thMM
If oSize.Height = 0 OR oSize.Width = 0 Then
' 2540 is 25.40 mm in an inch, but I need 100th mm.
' There are 1440 twips in an inch
oSize.Height = oGraph.SizePixel.Height * 2540.0 * TwipsPerPixelY() / 1440
oSize.Width = oGraph.SizePixel.Width * 2540.0 * TwipsPerPixelX() / 1440
End If
If oSize.Height = 0 OR oSize.Width = 0 Then
oSize.Height = 2540
oSize.Width = 2540
Exit Function
End If
If oSize.Width > lMaxW Then
oSize.Height = oSize.Height * lMaxW / oSize.Width
oSize.Width = lMaxW
End If
If oSize.Height > lMaxH Then
oSize.Width = oSize.Width * lMaxH / oSize.Height
oSize.Height = lMaxH
End If
RecommendGraphSize = oSize
End Function
