''El modulo es:
Public objExcel As Excel.Application
Public Function Inicio_Excel() As Boolean
'''Volcado Excel
Dim I As Integer
Dim J As Integer
Set objExcel = New Excel.Application
objExcel.Visible = True 'lo hacemos visible
objExcel.SheetsInNewWorkbook = 1 'decimos cuantas hojas queremos en el nuevo documento
objExcel.Workbooks.Add ' añadimos el objeto al workbook
End Function
Public Function Formato_Excel(Num_Campos As Integer, Nombre_Campos() As String) As Boolean
''Volcado Excel
With objExcel.ActiveSheet
'Formato de las celdas de los titulos
.Range(.Cells(3, 1), .Cells(3, Num_Campos)).Borders.LineStyle = xlContinuous
.Range(.Cells(3, 1), .Cells(3, 23)).Font.Bold = True
For I = 1 To Num_Campos - 1 Step 1
.Cells(3, I) = Nombre_Campos(I)
Next I
'hasta aki pa colocar los titulos
'a partir de aki ta claro que es pa darle el ancho a las celdas;-)
.Columns("A").ColumnWidth = 20
.Columns("B").ColumnWidth = 20
.Columns("C").ColumnWidth = 8
.Columns("D").ColumnWidth = 15
.Columns("E").ColumnWidth = 15
.Columns("F").ColumnWidth = 15
.Columns("G").ColumnWidth = 18
.Columns("H").ColumnWidth = 10
.Columns("I").ColumnWidth = 30
.Columns("J").ColumnWidth = 10
.Columns("K").ColumnWidth = 18
.Columns("L").ColumnWidth = 18
.Columns("M").ColumnWidth = 15
.Columns("N").ColumnWidth = 15
.Columns("O").ColumnWidth = 15
.Columns("P").ColumnWidth = 15
.Columns("Q").ColumnWidth = 20
.Columns("R").ColumnWidth = 15
.Columns("S").ColumnWidth = 15
.Columns("T").ColumnWidth = 15
.Columns("U").ColumnWidth = 15
.Columns("V").ColumnWidth = 15
.Columns("W").ColumnWidth = 15
End With
End Function
'''en el formulario:
Private Sub VolcadoExcel_Click()
Data2.DatabaseName = App.Path & "\Tarjetas.mdb"
Data2.RecordSource = "Temporal"
Data2.Refresh
Dim Heading(23) As String 'aki vamos a guardar los nombres de los campos que despues pasamos a la funcion
Heading(1) = "Tarjeta1"
Heading(2) = "Tarjeta2"
Heading(3) = "Empresa"
Heading(4) = "Nombre"
Heading(5) = "Apellido1"
Heading(6) = "Apellido2"
Heading(7) = "Fecha Nacimiento"
Heading(8) = "DNI"
Heading(9) = "Dirección"
Heading(10) = "Foto"
Heading(11) = "Teléfono Personal"
Heading(12) = "Teléfono Empresa"
Heading(13) = "Hora Entrada"
Heading(14) = "Hora Salida"
Heading(15) = "Fecha Entrada"
Heading(16) = "Fecha Salida"
Heading(17) = "Comentario"
Heading(18) = "PendienteSalida"
Heading(19) = "Ficha Cubierta"
Heading(20) = "Peso Entrada"
Heading(21) = "Peso Salida"
Heading(22) = "Diferencia de Pesadas"
Call Inicio_Excel 'Llamamos a la funcion que abre el workbook en excel
Call Formato_Excel(23, Heading()) 'llamamos a la funcion que da el formato al nuevo workbook
V = 5
H = 1
Do While Not Data2.Recordset.EOF 'esto nos sirve pa leer los datos desde
'la tabla de access para déspues colocarlos en las celdas correspondientes
With Data2.Recordset
objExcel.ActiveSheet.Cells(V, H) = .Fields!Tarjeta1
objExcel.ActiveSheet.Cells(V, H + 1) = .Fields!Tarjeta2
objExcel.ActiveSheet.Cells(V, H + 2) = .Fields!Empresa
objExcel.ActiveSheet.Cells(V, H + 3) = .Fields!Nombre
objExcel.ActiveSheet.Cells(V, H + 4) = .Fields!Apellido1
objExcel.ActiveSheet.Cells(V, H + 5) = .Fields!Apellido2
objExcel.ActiveSheet.Cells(V, H + 6) = .Fields![Fecha de Nacimiento]
objExcel.ActiveSheet.Cells(V, H + 7) = .Fields!DNI
objExcel.ActiveSheet.Cells(V, H + 8) = .Fields!Dirección
objExcel.ActiveSheet.Cells(V, H + 9) = .Fields!Foto
objExcel.ActiveSheet.Cells(V, H + 10) = .Fields![Teléfono Personal]
objExcel.ActiveSheet.Cells(V, H + 11) = .Fields![Teléfono Empresa]
objExcel.ActiveSheet.Cells(V, H + 12) = .Fields![Hora Entrada]
objExcel.ActiveSheet.Cells(V, H + 13) = .Fields![Hora Salida]
objExcel.ActiveSheet.Cells(V, H + 14) = .Fields![Fecha Entrada]
objExcel.ActiveSheet.Cells(V, H + 15) = .Fields![Fecha Salida]
objExcel.ActiveSheet.Cells(V, H + 16) = .Fields!Comentarios
objExcel.ActiveSheet.Cells(V, H + 17) = .Fields![PendienteSalida]
objExcel.ActiveSheet.Cells(V, H + 18) = .Fields![FichaCubierta]
objExcel.ActiveSheet.Cells(V, H + 19) = .Fields![Peso Entrada]
objExcel.ActiveSheet.Cells(V, H + 20) = .Fields![Peso Salida]
objExcel.ActiveSheet.Cells(V, H + 21) = .Fields![Diferencia de Pesadas]
V = V + 1
.MoveNext
End With
Loop
Set objExcel = Nothing 'una vez hemos terminado descargamos el objeto
End Sub