Código: Seleccionar todo
' Creación del servicio OpenOffice
Set ServiceManager = CreateObject("com.sun.star.ServiceManager")
'Se inicia la funcion CoreReflection que es usada mas tarde para crear estructuras
Set objCoreReflection = ServiceManager.CreateInstance("com.sun.star.reflection.CoreReflection")
Set Desktop = ServiceManager.CreateInstance("com.sun.star.frame.Desktop")
'crear documento añadir ==> Array(MakePropertyValue("Password", ""))
Set Document = Desktop.loadComponentFromURL(Ruta_Plant, "_blank", 0, Array(MakePropertyValue("Password", "SAPOS")))
Luego invoco esta Sub:
Public Sub Manejo_de_Filas()
Dim flag_insertar As Boolean
Dim Itera As Integer
Dim S2 As String
Dim aSize As Object 'Objeto para la Huella Dactilar
Dim oCelda As Object 'Objeto para la Huella Dactilar
Dim oTabla As Object 'Objeto para la Huella Digital
Dim oTexto As Object 'Objeto para la Huella Dactilar
Dim oCursor As Object 'Objeto para la Huella Dactilar
flag_insertar = False
Itera = 0
Set Tabla = TextTables.getByName("WWT1")
Set Filas = Tabla.GetRows
NombresCelda = Tabla.getCellNames()
cx = ""
For i = 1 To MAT(J, 6) 'Hasta número de imagenes o textos
cx = MAT(J, G + i) 'Texto a insertar
Set Celda = Tabla.getCellByName(NombresCelda(Val(5) 'La Celda donde insertare la imagen
Set CursorCelda = Celda.createTextCursor()
If InStr(cx, "bmp") > 0 Then 'si el texto trae referencia de una imagen BMP
'Aqui para las pruebas de la Imagen
' Crear una Instancia del Objeto Gráfico para la Imagen
Url_Img = Replace(Dir_G, "\Originales", "") & "hls\" & cx 'Ruta de donde está almacenada la imagen
If FileExists(Url_Img) = False Then
MsgBox "No Existe Imagen..."
Else
Url_Img = Replace(Url_Img, "\", "/")
Url_Img = "file:///" & Url_Img
Set oImagen = Document.CreateInstance("com.sun.star.text.GraphicObject")
Set oTexto = Celda.GetText()
Set aSize = oTexto.Bridge_GetStruct("com.sun.star.awt.Size") 'Reemplaza a Dim aSize As New ("com.sun.star.awt.Size")
Set oCursor = oTexto.createTextCursorByRange(oTexto.getStart())
Celda.String = "" 'Limpio la Celda
oImagen.GraphicURL = Url_Img
aSize.width = 2700
aSize.height = 3200
Call oImagen.setsize(aSize)
Call oTexto.insertTextContent(oCursor, oImagen, True)
oImagen.TextWrap = 1
' Aqui necesito la instrucción para que la imagen haga que la Celda adopte su Tamaño...
End If
Else
Celda.String = UCase(cx)
End If
'Aqui hago un manejo para que se inserten tantas Filas en la tabla como se requieran... una a una
If Vector_Filas(N_F, 3, Val(M_Filas(5))) = "NO" Then
If i < MAT(J, 6) Then
If Itera = 0 Then
S2 = "A" & Mid(NombresCelda(Val(M_Filas(2))), 2)
Set Celda = Tabla.getCellByName(S2)
Set CursorCelda = Celda.createTextCursor()
If M_Filas(10) <> "" Then
Celda.String = M_Filas(10) & " " & Itera + 1
End If
End If
Call Filas.insertByIndex(KL, 1) 'Para insertar FILAS
Itera = Itera + 1
KL = KL + 1
M_Filas(2) = Val(M_Filas(2)) + Val(M_Filas(3))
NombresCelda = Tabla.getCellNames()
'Aqui me ubico en la Primer Celda de la Fila para escribir el contenido
'que se repite cuando se inserta una Fila para los valores en la Plantilla
S2 = "A" & Mid(NombresCelda(Val(M_Filas(2))), 2)
Set Celda = Tabla.getCellByName(S2)
Set CursorCelda = Celda.createTextCursor()
If M_Filas(10) <> "" Then
Celda.String = M_Filas(10) & " " & Itera + 1
End If
End If
flag_insertar = True
Else
M_Filas(2) = Val(M_Filas(2)) + Val(M_Filas(3))
End If
Next i
If flag_insertar = True Then
flag_insertar = False
Vector_Filas(N_F, 3, M_Filas(5)) = "SI"
Vector_Filas(N_F, 2, M_Filas(5)) = Itera
Vector_Filas(N_F, 1, M_Filas(5)) = M_Filas(4)
End If
End SubGracias...si no está clara la pregunta me avisan...
