Visual Basic - Código de Visual Basic para editar archivo Excel

Life is soft - evento anual de software empresarial
 
Vista:
Imágen de perfil de Hanz
Val: 2
Ha aumentado su posición en 29 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Código de Visual Basic para editar archivo Excel

Publicado por Hanz (17 intervenciones) el 31/03/2020 21:22:41
Hola gente, soy nuevo por aquí... Hace mucho tiempo aprendí cosas básicas de Visual Basic 5, programa obsoleto lo sé, pero es dónde aprendí...

Estoy elaborando un programa conectado a una base de datos de access, utilizé excel para poder crear informes de las búsquedas de la información. Esta búsqueda se hace en un form y las personas encontradas según lo solicitado, se visualiza en un Listbox. Al presionar el botón elaborar reporte, el código crea un archivo de excel, y comienza a comparar los resultados del Listbox con los de la base de datos de access, cada vez que encuentra una similitud, se escribe en el excel. Al presiona el botón de elaborar reporte la primera vez, el documento de excel, se crea sin problema, pero la segunda vez que lo ejecuto, me da un error en la primer linea ActiveCell, Run-time Error "91", Object Variable or With block variable not set.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Private Sub Command2_Click()
List1.SetFocus
List1.ListIndex = 0
If (List1.List(List1.ListIndex)) = "" & " " & "" & " " & "" & " " & "" & " " & "" & " " & "" & " " & "" Then
MsgBox ("Debe realizar una búsqueda primero"), vbInformation, "COMTRA"
Else
Dim Excel As Object
Dim Libro As Object
Dim Hoja As Object
 
 
'Abrir un nuevo libro en Excel
Set cExcel = CreateObject("Excel.Application")
Set Libro = cExcel.Workbooks.Add
Set Hoja = Libro.Worksheets(1)
 
'Agregar datos a las celdas de la primera hoja en el nuevo libro
cExcel.Visible = True
Hoja.Range("A1").Value = "Número de identificación"
Hoja.Range("B1").Value = "Apellido1"
Hoja.Range("C1").Value = "Apellido2"
Hoja.Range("D1").Value = "Nombre"
Hoja.Range("E1").Value = "Tipo de usuario"
Hoja.Range("F1").Value = "Sección"
Hoja.Range("G1").Value = "Marca comedor"
Hoja.Range("H1").Value = "Hora de marca Comedor"
Hoja.Range("I1").Value = "Marca comedor becado"
Hoja.Range("J1").Value = "Hora de marca comedor becado"
Hoja.Range("K1").Value = "Marca almuerzo"
Hoja.Range("L1").Value = "Hora de almuerzo"
Hoja.Range("M1").Value = "Plato principal"
Hoja.Range("N1").Value = "Ensalada"
Hoja.Range("O1").Value = "Bebida"
Hoja.Range("P1").Value = "Fruta"
Hoja.Range("Q1").Value = "Marca transporte"
Hoja.Range("R1").Value = "Hora de marca transporte"
Hoja.Range("S1").Value = "Marca transporte becado"
Hoja.Range("T1").Value = "Hora de transporte becado"
Hoja.Range("U1").Value = "Ruta"
Hoja.Range("V1").Value = "Dia"
Hoja.Range("W1").Value = "Mes"
Hoja.Range("X1").Value = "Año"
Hoja.Range("Y1").Value = "Nombre funcionario al almorzar"
Hoja.Range("Z1").Value = "Apellido1 funcionario al almorzar"
Hoja.Range("AA1").Value = "Apellido2 funcionario al almorzar"
Hoja.Range("A1:AA1").Font.Bold = True
Hoja.Range("A1:AA1").HorizontalAlignment = xlCenter
Hoja.Range("A1:AA1").Interior.Color = RGB(226, 239, 218)
Hoja.Range("A2").Select
 
'Pasar los datos a excel según el List1
Cont = "0"
List1.ListIndex = 0
While Cont < List1.ListCount
    If Marcas.RecordCount <> 0 Then
        Marcas.MoveFirst
        While Marcas.EOF = False
           If (List1.List(List1.ListIndex)) = Marcas("ID") & " " & Marcas("Nombre_Usuario") & " " & Marcas("Apellido1_Usuario") & " " & Marcas("Apellido2_Usuario") & " " & Marcas("Día") & " " & Marcas("Mes") & " " & Marcas("Año") Then
           ActiveCell.Value = Marcas("ID") AQUÍ DA EL ERROR
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Apellido1_Usuario")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Apellido2_Usuario")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Nombre_Usuario")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Tipo_Usuario")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Sección")
           ActiveCell.Offset(0, 1).Select
           If Marcas("Comedor") = True Then
           ActiveCell.Value = "X"
           End If
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Hora_Comedor")
           ActiveCell.Offset(0, 1).Select
           If Marcas("Comedor_Beca") = True Then
           ActiveCell.Value = "X"
           End If
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Hora_Comedorbeca")
           ActiveCell.Offset(0, 1).Select
           If Marcas("Almuerzo") = True Then
           ActiveCell.Value = "X"
           End If
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Hora_Almuerzo")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Plato")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Ensalada")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Bebida")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Fruta")
           ActiveCell.Offset(0, 1).Select
           If Marcas("Transporte") = True Then
           ActiveCell.Value = "X"
           End If
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Hora_Transporte")
           ActiveCell.Offset(0, 1).Select
           If Marcas("Transporte_Beca") = True Then
           ActiveCell.Value = "X"
           End If
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Hora_Transportebeca")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Ruta")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Día")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Mes")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Año")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Nom_Func")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Apellido1_Func")
           ActiveCell.Offset(0, 1).Select
           ActiveCell.Value = Marcas("Apellido2_Func")
           ActiveCell.Offset(1, -26).Select
           End If
        Marcas.MoveNext
        Wend
        If Cont = (List1.ListCount - 2) Then
        Cont = Cont + 2
        Else
        Cont = Cont + 2
        List1.ListIndex = Cont
        End If
    End If
Wend
 
 
Carp1 = Dir("C:\Users\Nitro\Desktop\COMTRA", vbDirectory)
If Carp1 = "" Then
MkDir ("C:\Users\Nitro\Desktop\COMTRA")
End If
 
'Guardar el libro de Excel
Dim x As String
Dim y As String
 
x = ""
y = 1
 
While y = 1
If Dir("C:\Users\Nitro\Desktop\COMTRA\Reporte_COMTRA" & x & ".xls") <> Empty Or Dir("C:\Users\Nitro \Desktop\COMTRA\Reporte_COMTRA" & x & ".xls") <> Empty Then
If x = "" Then
x = 0
End If
x = x + 1
Else
Libro.SaveAs "C:\Users\Nitro\Desktop\COMTRA\Reporte_COMTRA" & x & ".xls"
y = 0
End If
Wend
 
'Cerrar Excel
cExcel.Quit
Set cExcel = Nothing
End If
 
End Sub
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