Posteado por: alejandrolaorden | 23 junio, 2014

informe de Visual Basic en Open Office

‘Aquí va un valioso ejemplo de cómo programar un informe para que salga en Open Office Calc

 

'FUNCIONES USADAS POR ALEJANDRO LAORDEN
 Function abcedario() As String
Dim x, Y, z As Integer
 Dim abc() As String
ReDim Preserve abc(0)
 For x = 1 To 26
 ReDim Preserve abc(x)
 abc(x) = Chr(64 + x)
 Next x
 z = 26
 For x = 1 To 26
 For Y = 1 To 26
 z = z + 1
 ReDim Preserve abc(z)
 abc(z) = Chr(64 + x) & Chr(64 + Y)
 Next Y
 Next x
abcedario = "0,"
 For x = 1 To UBound(abc)
 abcedario = abcedario & abc(x) & ","
 Next x
 abcedario = Left(abcedario, Len(abcedario) - 1)
 End Function
Sub DefRango(ByRef oWorksheet As Object, ByRef oRange As Object, filao As Integer, columno As Integer, filad As Integer, columnd As Integer)
 Dim abc() As String
 abc = Split(abcedario, ",")
 Dim strF As String
 strF = abc(columno) & CStr(filao) & ":" & abc(columnd) & CStr(filad)
 Set oRange = oWorksheet.getCellRangeByName(strF)
 End Sub
Sub DefRangoFor(ByRef oWorksheet As Object, ByRef oRange As Object, filao As Integer, columno As Integer, filad As Integer, columnd As Integer, sFormula As String)
 Dim abc() As String
 abc = Split(abcedario, ",")
 Dim strF As String
 strF = abc(columno) & CStr(filao) & ":" & abc(columnd) & CStr(filad)
 Set oRange = oWorksheet.getCellRangeByName(strF)
 oRange.SetFormula (sFormula)
 End Sub
Sub Bordes(ByRef oRange As Object)
 Dim Border As Object
 Dim Style As Object
Set Border = oRange.TableBorder
Set Style = Border.TopLine
 Style.OuterLineWidth = 25
 Style.Color = RGB(0, 0, 0)
 Border.TopLine = Style
Set Style = Border.bottomline
 Style.OuterLineWidth = 25
 Style.Color = RGB(0, 0, 0)
 Border.bottomline = Style
Set Style = Border.leftline
 Style.OuterLineWidth = 25
 Style.Color = RGB(0, 0, 0)
 Border.leftline = Style
Set Style = Border.rightline
 Style.OuterLineWidth = 25
 Style.Color = RGB(0, 0, 0)
 Border.rightline = Style
oRange.TableBorder = Border
 End Sub
Sub ExportaInvDIF_Oo_Diferencias(ByVal strModo As String)
 Dim ServiceManager As Object
 Dim Desktop As Object
 Dim oDocument As Object
 Dim oWorksheet As Object
 Dim oRange As Object
 Dim args()
 Dim iFila As Integer
 Dim I As Integer
 Dim lngExistencia As Long
Dim strF As String
 Dim strSQL As String
 Dim Fila As Integer
 Dim filaini As Integer
 Dim filafin As Integer
Dim cnADO As New ADODB.Connection
 Dim rs As New ADODB.Recordset
Dim abc() As String
 abc = Split(abcedario, ",")
On Error GoTo ReparaErrores
 ConnectBD cnADO
ExecuteSQL cnADO, "DROP TABLE PREEL"
strSQL = "SELECT * INTO PREL FROM PR WHERE Id='" & EC(Trim(gon)) & "' AND ACTIVO=1"
 cnADO.Execute strSQL, , adExecuteNoRecords
If strModo = "Io" Then
strSQL = "SELECT * from dis"
 End If
rs.Open strSQL, cnADO, adOpenStatic, adLockReadOnly
If rs.EOF Then
 'MsgBox "No se han encontrado diferencias.", vbOKOnly, "No Hay Diferencias"
 Exit Sub
 End If
Set ServiceManager = CreateObject("com.sun.star.ServiceManager")
 Set Desktop = ServiceManager.createInstance("com.sun.star.frame.Desktop")
 Set oDocument = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
 Set oWorksheet = oDocument.getSheets().getByIndex(0)
 oWorksheet.Name = EsNuloT(strModo)
 Set oRange = oWorksheet.getCellRangeByName("A1:" & abc(13) & "1") 'TOMO UN RANGO
 oRange.Merge (True)
 Call oRange.SetPropertyValue("CharHeight", 12)
 Call oRange.SetPropertyValue("CharFontName", "Calibri")
 Call oRange.SetPropertyValue("CharWeight", 150) 'ESTO ES PONERLO EN NEGRITA!!!
 Call Bordes(oRange)
 If gblnEstadosStock Then
 strF = EsNuloT(strModo) & " Tienda: " & gn & " (" & Trim$(cs.Text) & " ) / " & EsNuloT(so) & " a " & date
 Call oWorksheet.getcellbyposition(0, 0).SetFormula(strF) 'OJO LAS CELDAS EMPIEZAN EN 0,0 NO EN 1,1
 Else
 strF = "Ina: " & gson & " / " & "Diferencias a " & date
 Call oWorksheet.getcellbyposition(0, 0).SetFormula(strF)
 End If
 Call oRange.SetPropertyValue("CellBackColor", RGB(255, 255, 204)) 'RGB VA AL REVES
Fila = 3: iFila = Fila
 Call DefRango(oWorksheet, oRange, iFila, 1, iFila, 1)
 Call oRange.SetFormula("F")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 2, iFila, 2)
 Call oRange.SetFormula("S")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 3, iFila, 3)
 Call oRange.SetFormula("T")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 4, iFila, 4)
 Call oRange.SetFormula("R")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 5, iFila, 5)
 Call oRange.SetFormula("PVP")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 6, iFila, 6)
 Call oRange.SetFormula("D")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 7, iFila, 7)
 Call oRange.SetFormula("P")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 8, iFila, 8)
 Call oRange.SetFormula("Stock")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 9, iFila, 9)
 Call oRange.SetFormula("U.")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 10, iFila, 10)
 Call oRange.SetFormula("Dif.")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 11, iFila, 11)
 Call oRange.SetFormula("PVP")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 12, iFila, 12)
 Call oRange.SetFormula("Dte")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 13, iFila, 13)
 Call oRange.SetFormula("Pe")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, iFila, 1, iFila, 13)
 Call oRange.SetPropertyValue("CharWeight", 150)
 Call oRange.SetPropertyValue("CellBackColor", RGB(0, 0, 128)) 'RGB VA AL REVES
 Call oRange.SetPropertyValue("CharColor", RGB(255, 255, 255))
 Call oRange.SetPropertyValue("HoriJustify", 2)
 Call oRange.SetPropertyValue("CharHeight", 11)
 Call oRange.SetPropertyValue("CharFontName", "Calibri")
pg.Min = 0: pg.Max = rs.RecordCount: pg.value = 0: pg.Visible = True
 filaini = Fila
 While Not rs.EOF
 pg.value = pg.value + 1
 If gblnEstadosStock Then
 lngExistencia = 0
 If GetEstadoStock(Trim$(cboEstados.Text)) = "VEND" Then
 'Estado de stock VENDIBLES
 lngExistencia = EsNuloN(rs!Existencias) - EsNuloN(ExistenciaEstadosStockExcel(Gelo(cnADO, EsNuloT(rs!Referencia)), True))
 Else
 'Demas estados de STOCK
 lngExistencia = EsNuloN(ExistenciaEstadosStockExcel(Go(cnADO, EsNuloT(rs!Referencia)), False))
 End If
 End If
 If (((EsNuloN(rs!Inventario) - EsNuloN(lngExistencia)) <> 0) Or _
 (lngExistencia <> 0) Or _
 (EsNuloN(rs!Inventario) <> 0) _
 ) Then
 Fila = Fila + 1: filafin = Fila
 Call DefRangoFor(oWorksheet, oRange, Fila, 1, Fila, 1, EsNuloT(rs!F))
 Call DefRangoFor(oWorksheet, oRange, Fila, 2, Fila, 2, EsNuloT(rs!S))
 Call DefRangoFor(oWorksheet, oRange, Fila, 3, Fila, 3, EsNuloT(rs!T))
 Call DefRangoFor(oWorksheet, oRange, Fila, 4, Fila, 4, EsNuloT(rs!R))
 Call DefRangoFor(oWorksheet, oRange, Fila, 5, Fila, 5, EsNuloT(rs!PVP))
 Call DefRangoFor(oWorksheet, oRange, Fila, 6, Fila, 6, EsNuloT(rs!D))
 Call DefRangoFor(oWorksheet, oRange, Fila, 7, Fila, 7, EsNuloT(rs!P))
 If gblnEstadosStock Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 8, Fila, 8, EsNuloN(lia))
 Else
 Call DefRangoFor(oWorksheet, oRange, Fila, 8, Fila, 8, EsNuloN(rs!Es))
 End If
 Call DefRangoFor(oWorksheet, oRange, Fila, 9, Fila, 9, EsNuloT(rs!Io))
 If gk Then
 If (EsNuloT(rs!Io) - EsNuloT(la)) = 0 Then
Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, "0")
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, "0")
 ElseIf (EsNuloT(rs!Io) - EsNuloT(la)) > 0 Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, "0")
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, EsNuloT(rs!Io) - EsNuloT(lia))
 ElseIf (EsNuloT(rs!Inventario) - EsNuloT(lngExistencia)) < 0 Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, EsNuloT(rs!io) - EsNuloT(lia))
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, "0")
 End If
 Else
 If (EsNuloT(rs!IO) - EsNuloT(rs!E)) = 0 Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, "0")
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, "0")
 ElseIf (EsNuloT(rs!IO) - EsNuloT(rs!E)) > 0 Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, "0")
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, EsNuloT(rs!IO) - EsNuloT(rs!E))
 ElseIf (EsNuloT(rs!IO) - EsNuloT(rs!E)) < 0 Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, EsNuloT(rs!IO) - EsNuloT(rs!E))
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, "0")
 End If
 End If
 End If
 If strModo = "Inventario" Then
 Call DefRangoFor(oWorksheet, oRange, Fila, 11, Fila, 11, "=E" & Fila & "*I" & Fila)
 Else
 Call DefRangoFor(oWorksheet, oRange, Fila, 11, Fila, 11, "=E" & Fila & "*J" & Fila)
 oRange.NumberFormat = 4
 Call DefRangoFor(oWorksheet, oRange, Fila, 13, Fila, 13, "=E" & Fila & "*L" & Fila)
 oRange.NumberFormat = 4
 End If
rs.MoveNext
 Wend
 CloseRS rs
Call DefRango(oWorksheet, oRange, filaini, 1, filafin, 13)
 Call oRange.SetPropertyValue("CharHeight", 11)
 Call oRange.SetPropertyValue("CharFontName", "Calibri")
 Call Bordes(oRange)
 Call DefRango(oWorksheet, oRange, filaini, 2, filafin, 13)
 Call oRange.SetPropertyValue("HoriJustify", 2)
 Call DefRango(oWorksheet, oRange, filaini, 5, filafin, 5)
 oRange.NumberFormat = 4
Fila = Fila + 1
Call DefRangoFor(oWorksheet, oRange, Fila, 7, Fila, 7, "TOTALES")
 Call DefRangoFor(oWorksheet, oRange, Fila, 8, Fila, 8, "=SUM(H4:H" & Fila - 1 & ")")
 Call DefRangoFor(oWorksheet, oRange, Fila, 9, Fila, 9, "=SUM(I4:I" & Fila - 1 & ")")
 Call DefRangoFor(oWorksheet, oRange, Fila, 10, Fila, 10, "=SUM(J4:J" & Fila - 1 & ")")
 Call DefRangoFor(oWorksheet, oRange, Fila, 12, Fila, 12, "=SUM(L4:L" & Fila - 1 & ")")
 Call DefRangoFor(oWorksheet, oRange, Fila, 11, Fila, 11, "=SUM(K4:K" & Fila - 1 & ")")
 oRange.NumberFormat = 4
 Call DefRangoFor(oWorksheet, oRange, Fila, 13, Fila, 13, "=SUM(M4:M" & Fila - 1 & ")")
 oRange.NumberFormat = 4
 Call DefRango(oWorksheet, oRange, Fila, 7, Fila, 13)
 Call Bordes(oRange)
 Call oRange.SetPropertyValue("CharWeight", 150)
 Call oRange.SetPropertyValue("CellBackColor", RGB(204, 255, 255))
 Call oRange.SetPropertyValue("HoriJustify", 2)
 Dim objCols As Object
Set objCols = oWorksheet.GetColumns
 Dim objCol As Object
 For I = 0 To 13
 Set objCol = objCols.getByIndex(I)
 objCol.OptimalWidth = True
 Next I
 Dim Col As Object
 If strModo = "IO" Then
 Set Col = oWorksheet.Columns(9)
 Col.IsVisible = 0
 End If
ReparaErrores:
 CloseRS rs: CloseCN cnADO
 pg.value = pg.Max: pg.Visible = False
 If Err Then
 Call ReparaErrores(Me.Name, "Expias", Err.Description, Err.Number)
 Err.Clear
 End If
 End Sub

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s

Categorías

A %d blogueros les gusta esto: