desde codigo fuente
Publicado por VIBET (25 intervenciones) el 22/09/2005 02:31:35
Me ha bajado de la sección de código fuente de la página un ejemplo y por si solo me funciona pero lo intento acoplar a un proyecto que estoy haciendo y me da un error, podría alguién quitarme la venda y decirme en qué me falla el código
el ejemplo es exportar a excel2
este es mi codigo, por un lado lleva una FUNCION:
Public xExcel As Excel.Application
Public Function Inicio_Excel() As Boolean
Dim I As Integer
Dim J As Integer
Set xExcel = New Excel.Application
xExcel.Workbooks.Add App.Path & "\ETIQUETAS.xlt"
End Function
Public Function Formato_Excel(Num_Campos As Integer, Nombre_Campos() As String) As Boolean
With xExcel.ActiveSheet
.Range(.Cells(3, 1), .Cells(3, Num_Campos)).Borders.LineStyle = xlContinuous
.Range(.Cells(3, 1), .Cells(3, 8)).Font.Bold = True
For I = 1 To Num_Campos - 1 Step 1
.Cells(3, I) = Nombre_Campos(I)
Next I
End With
End Function
y esta es la llamada:
Dim v As Integer
Dim h As Integer
Dim xExcel As Excel.Application
Dim wBook As Workbook
Dim Heading(4) As String pasamos a la funcion
Heading(0) = "Nombre"
Heading(1) = "codigo"
Heading(2) = "pvp"
Heading(3) = "alias"
titulo = "CAPRICHOS36"
If Val(Me.GrdInfoClientes.TextMatrix(Me.GrdInfoClientes.Row, 0)) <= 0 Then
MsgBox "No Hay Datos Para Listar ", vbCritical, titulo
Else
' Set xExcel = New Excel.Application
' xExcel.Workbooks.Add App.Path & "\ETIQUETAS.xlt"
'Hacer un Bucle para Calcular el N Reg
sql = ("select * from ARTICULOS where codigo = " & Me.GrdInfoClientes.TextMatrix(Me.GrdInfoClientes.Row, 0) & " ")
sbase = "c:\caprichos\base\caprichos.mdb"
Set db = OpenDatabase(sbase)
Set Rst = db.OpenRecordset(sql)
Call Inicio_Excel
Call Formato_Excel(4, Heading())
v = 2
h = 1
Do While Not Rst.EOF
With Rst ''------AQUÍ ME DA EL ERROR, VARIABLE NO DEFINIDA en el ejemplo pone with database.Recorset porque la base está en acces 97 pero hago la sql para 2000------
xExcel.ActiveSheet.Cells(v, h) = Rst!Nombre
xExcel.ActiveSheet.Cells(v + 1, h) = Rst!codigo
xExcel.ActiveSheet.Cells(v + 2, h) = Rst!pvp
xExcel.ActiveSheet.Cells(v + 3, h) = Rst!alias
v = v + 8
If v = 58 Then
h = h + 1
v = 2
End If
.MoveNext
End With
Loop
Set xExcel = Nothing
End If
end sub
el ejemplo es exportar a excel2
este es mi codigo, por un lado lleva una FUNCION:
Public xExcel As Excel.Application
Public Function Inicio_Excel() As Boolean
Dim I As Integer
Dim J As Integer
Set xExcel = New Excel.Application
xExcel.Workbooks.Add App.Path & "\ETIQUETAS.xlt"
End Function
Public Function Formato_Excel(Num_Campos As Integer, Nombre_Campos() As String) As Boolean
With xExcel.ActiveSheet
.Range(.Cells(3, 1), .Cells(3, Num_Campos)).Borders.LineStyle = xlContinuous
.Range(.Cells(3, 1), .Cells(3, 8)).Font.Bold = True
For I = 1 To Num_Campos - 1 Step 1
.Cells(3, I) = Nombre_Campos(I)
Next I
End With
End Function
y esta es la llamada:
Dim v As Integer
Dim h As Integer
Dim xExcel As Excel.Application
Dim wBook As Workbook
Dim Heading(4) As String pasamos a la funcion
Heading(0) = "Nombre"
Heading(1) = "codigo"
Heading(2) = "pvp"
Heading(3) = "alias"
titulo = "CAPRICHOS36"
If Val(Me.GrdInfoClientes.TextMatrix(Me.GrdInfoClientes.Row, 0)) <= 0 Then
MsgBox "No Hay Datos Para Listar ", vbCritical, titulo
Else
' Set xExcel = New Excel.Application
' xExcel.Workbooks.Add App.Path & "\ETIQUETAS.xlt"
'Hacer un Bucle para Calcular el N Reg
sql = ("select * from ARTICULOS where codigo = " & Me.GrdInfoClientes.TextMatrix(Me.GrdInfoClientes.Row, 0) & " ")
sbase = "c:\caprichos\base\caprichos.mdb"
Set db = OpenDatabase(sbase)
Set Rst = db.OpenRecordset(sql)
Call Inicio_Excel
Call Formato_Excel(4, Heading())
v = 2
h = 1
Do While Not Rst.EOF
With Rst ''------AQUÍ ME DA EL ERROR, VARIABLE NO DEFINIDA en el ejemplo pone with database.Recorset porque la base está en acces 97 pero hago la sql para 2000------
xExcel.ActiveSheet.Cells(v, h) = Rst!Nombre
xExcel.ActiveSheet.Cells(v + 1, h) = Rst!codigo
xExcel.ActiveSheet.Cells(v + 2, h) = Rst!pvp
xExcel.ActiveSheet.Cells(v + 3, h) = Rst!alias
v = v + 8
If v = 58 Then
h = h + 1
v = 2
End If
.MoveNext
End With
Loop
Set xExcel = Nothing
End If
end sub
Valora esta pregunta


0