Visual Basic - Ayuda-Excel-Visual

Life is soft - evento anual de software empresarial
 
Vista:

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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Ayuda-Excel-Visual

Publicado por Marco (20 intervenciones) el 31/05/2005 16:56:40
prueba esté codigo te servira lo unico que debo arreeglar es las fechas que me las da vuelta
Private Sub cmdtoexcell_Click()
Dim ApExcel As Variant
Set ApExcel = CreateObject("Excel.application")
' Hace que Excel se vea
ApExcel.Visible = True
'Agrega un nuevo Libro
ApExcel.Workbooks.Add
Dim wkbSheet As Excel.Worksheet
Dim Rng As Excel.Range
ApExcel.Cells(1, 1) = "CODIGO"
ApExcel.Cells(1, 2) = "NOMBRE PRODUCTO"
ApExcel.Cells(1, 3) = "CANTIDAD"
ApExcel.Cells(1, 4) = "FECHA INGRESO"
ApExcel.Cells(1, 5) = "STOCK ACTUAL"
ApExcel.Cells(1, 6) = "PROVEEDOR"
' Hace una Seleccion de celdas y pone bordes de Color
ApExcel.Range("A1:F1").Borders.Color = RGB(255, 0, 0)

Set Rng = ApExcel.Range("A2:" + Chr(DataGrid1.Columns.Count + 64) + CStr(Adodc1.Recordset.RecordCount))

With Adodc1.Recordset
If .BOF = False Then .MoveFirst
If .EOF = False Then
Do Until .EOF
For I = 1 To .Fields.Count
If IsDate(.Fields(I - 1)) Then
Rng.Cells(.AbsolutePosition, I) = Format(.Fields(I - 1), "dd/mm/yyyy")
Else
Rng.Cells(.AbsolutePosition, I) = .Fields(I - 1)
End If
Next I
.MoveNext
Loop
End If
End With
Set ApExcel = Nothing
Set Rng = Nothing
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar