Ayuda-Excel-Visual
Publicado por Altapy (2 intervenciones) el 30/05/2005 09:45:46
hola tengo un problema con un codigo de visual al pasar los datos de un datagrid a una hoja de excel y el problema es q si hay registros q no esten presentes en la pantalla es decir q para verlos tengas q moverte con la barra me da un error de filas. Si me podeos ayudar os dejo aqui el codigo.
Private Sub cmdExcel_Click()
Dim wkbNew As Excel.Workbook
Dim wkbSheet As Excel.Worksheet
Dim Rng As Excel.Range
Dim e As Excel.Application
On Error GoTo errKill
Set e = New Excel.Application
e.Visible = True
If Dir("C:\Excel\Inventarios.xls") <> "" Then 'Si Existe el Archivo
Kill "C:\Excel\Inventarios.xls" 'Lo Eliminamos
End If
Set wkbNew = Workbooks.Add
wkbNew.SaveAs "C:\Excel\Inventarios.xls"
Set wkbSheet = wkbNew.Worksheets(1)
wkbSheet.Cells(1, 1) = "Serial"
wkbSheet.Cells(1, 2) = "Usuario"
wkbSheet.Cells(1, 3) = "Lugar"
wkbSheet.Cells(1, 4) = "Departamento"
wkbSheet.Cells(1, 5) = "Tipo Ordenador"
wkbSheet.Cells(1, 6) = "Procesador"
wkbSheet.Cells(1, 7) = "Placa"
wkbSheet.Cells(1, 8) = "Chip"
wkbSheet.Cells(1, 9) = "Ram"
wkbSheet.Cells(1, 10) = "Slots libres"
wkbSheet.Cells(1, 11) = "Memoria"
wkbSheet.Cells(1, 12) = "Tarjeta Grafica"
wkbSheet.Cells(1, 13) = "Conector"
wkbSheet.Cells(1, 14) = "Tarjeta Red"
wkbSheet.Cells(1, 15) = "Velocidad"
wkbSheet.Cells(1, 16) = "SO"
wkbSheet.Cells(1, 17) = "IP"
wkbSheet.Cells(1, 18) = "Fecha Compra"
wkbSheet.Cells(1, 19) = "Monitor"
wkbSheet.Cells(1, 20) = "Modelo"
wkbSheet.Cells(1, 21) = "Pulgadas"
wkbSheet.Range("A1:U1").Cells.Interior.Color = RGB(255, 255, 0)
Set Rng = wkbSheet.Range("A2:" + Chr(dbgListado.Columns.Count + 64) + CStr(adoBusqueda.Recordset.RecordCount))
dbgListado.Row = 0 'se coloca el cursor en la primera fila
dbgListado.Refresh
For i = 0 To adoBusqueda.Recordset.RecordCount - 1
For j = 0 To dbgListado.Columns.Count - 1
dbgListado.Col = j
dbgListado.Row = i
If adoBusqueda.Recordset.RecordCount - 1 = 0 Then
Rng.Range(Chr(j + 1 + 64) + CStr(i + 2)) = dbgListado.Text
Else
Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = dbgListado.Text
End If
Next j
adoBusqueda.Recordset.MoveNext
Next i
'Cerramos y Salvamos
wkbNew.Close True
'Cerramos todas las variables
Set e = Nothing
Set wkbNew = Nothing
Set wkbSheet = Nothing
Set Rng = Nothing
e.Quit
'Si queremos Abrir el Archivo
Dim MyValue
MyValue = Shell("rundll32.exe url.dll,FileProtocolHandler " & "C:\Excel\Inventarios.xls", vbMaximizedFocus)
'Exit Sub
errKill:
MsgBox Err.Description
End Sub
gracias
Private Sub cmdExcel_Click()
Dim wkbNew As Excel.Workbook
Dim wkbSheet As Excel.Worksheet
Dim Rng As Excel.Range
Dim e As Excel.Application
On Error GoTo errKill
Set e = New Excel.Application
e.Visible = True
If Dir("C:\Excel\Inventarios.xls") <> "" Then 'Si Existe el Archivo
Kill "C:\Excel\Inventarios.xls" 'Lo Eliminamos
End If
Set wkbNew = Workbooks.Add
wkbNew.SaveAs "C:\Excel\Inventarios.xls"
Set wkbSheet = wkbNew.Worksheets(1)
wkbSheet.Cells(1, 1) = "Serial"
wkbSheet.Cells(1, 2) = "Usuario"
wkbSheet.Cells(1, 3) = "Lugar"
wkbSheet.Cells(1, 4) = "Departamento"
wkbSheet.Cells(1, 5) = "Tipo Ordenador"
wkbSheet.Cells(1, 6) = "Procesador"
wkbSheet.Cells(1, 7) = "Placa"
wkbSheet.Cells(1, 8) = "Chip"
wkbSheet.Cells(1, 9) = "Ram"
wkbSheet.Cells(1, 10) = "Slots libres"
wkbSheet.Cells(1, 11) = "Memoria"
wkbSheet.Cells(1, 12) = "Tarjeta Grafica"
wkbSheet.Cells(1, 13) = "Conector"
wkbSheet.Cells(1, 14) = "Tarjeta Red"
wkbSheet.Cells(1, 15) = "Velocidad"
wkbSheet.Cells(1, 16) = "SO"
wkbSheet.Cells(1, 17) = "IP"
wkbSheet.Cells(1, 18) = "Fecha Compra"
wkbSheet.Cells(1, 19) = "Monitor"
wkbSheet.Cells(1, 20) = "Modelo"
wkbSheet.Cells(1, 21) = "Pulgadas"
wkbSheet.Range("A1:U1").Cells.Interior.Color = RGB(255, 255, 0)
Set Rng = wkbSheet.Range("A2:" + Chr(dbgListado.Columns.Count + 64) + CStr(adoBusqueda.Recordset.RecordCount))
dbgListado.Row = 0 'se coloca el cursor en la primera fila
dbgListado.Refresh
For i = 0 To adoBusqueda.Recordset.RecordCount - 1
For j = 0 To dbgListado.Columns.Count - 1
dbgListado.Col = j
dbgListado.Row = i
If adoBusqueda.Recordset.RecordCount - 1 = 0 Then
Rng.Range(Chr(j + 1 + 64) + CStr(i + 2)) = dbgListado.Text
Else
Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = dbgListado.Text
End If
Next j
adoBusqueda.Recordset.MoveNext
Next i
'Cerramos y Salvamos
wkbNew.Close True
'Cerramos todas las variables
Set e = Nothing
Set wkbNew = Nothing
Set wkbSheet = Nothing
Set Rng = Nothing
e.Quit
'Si queremos Abrir el Archivo
Dim MyValue
MyValue = Shell("rundll32.exe url.dll,FileProtocolHandler " & "C:\Excel\Inventarios.xls", vbMaximizedFocus)
'Exit Sub
errKill:
MsgBox Err.Description
End Sub
gracias
Valora esta pregunta


0