Exportar
Tengo un formulario con dos Datagrids al realizar consultas y llenarse ambos con información diferente los exporto a excel, le pediría de favor me indicara como le puedo hacer para que en el mismo libro que se habré en excel en la hoja 2 me exporte la información del Segundo Datagrid.
Ya que el actual código que le envío si quitamos en el CmdExportar la linea de código Valores, se lleva a cabo sin ningún problema la exportación del primer Grid, pero al activar esa linea me marca el siguiente error: 91 en tiempo de ejecución, variable de tipo Object o la variable de bloque with no esta establecida, al depurar me envía a la linea de código:
Private Sub valores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 30)).Borders.LineStyle = xlContinuous
Mi correo electrónico es [email protected] (Por Favor ayúdeme es lo único que me hace falta para el sistema que desarrollo en mi trabajo, y ya me están presionando para entregarlo)
Este es el código completo.
Private AppExcel As New Excel.Application
Private Sub CmdBuscar_Click()
If DataRegion.rsCmConsultaMpio.State = adStateOpen Then
DataRegion.rsCmConsultaMpio.Close
End If
DataRegion.CmConsultaMpio (DbcProfe.Text)
Set DbgrdMpio.DataSource = DataRegion.rsCmConsultaMpio
End Sub
Private Sub CmdExportar_Click()
AppExcel.Visible = True
AppExcel.Workbooks.Add
'Establecemos la hoja que utilizaremos
AppExcel.SheetsInNewWorkbook = 2
pasavalores
valores
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub CmdTodos_Click()
If DataRegion.rsCmConsultaTodos.State = adStateOpen Then
DataRegion.rsCmConsultaTodos.Close
End If
DataRegion.CmConsultaTodos
Set DbgrdCursos.DataSource = DataRegion.rsCmConsultaTodos
End Sub
**Exportar a excel DataGrid1**
Private Sub pasavalores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
.Cells(1, 1) = "Cve. Mpio"
.Cells(1, 2) = "Municipio"
.Cells(1, 3) = "Cve. Loc"
.Cells(1, 4) = "Localidad"
.Cells(1, 5) = "Escuelas"
.Cells(1, 6) = "Inscritos"
.Cells(1, 7) = "Existentes"
.Cells(1, 8) = "Aprobados_Hom"
.Cells(1, 9) = "Aprobados_Muj"
N = 1
.Range(.Cells(1, 1), .Cells(1, 9)).Font. Bold = True
End With
Do While DataRegion.rsCmConsultaMpio.EOF = False
DoEvents
AppExcel.ActiveSheet.Cells(N + 1, 1) = DataRegion.rsCmConsultaMpio!Cve_mpio
AppExcel.ActiveSheet.Cells(N + 1, 2) = DataRegion.rsCmConsultaMpio!Municipio
AppExcel.ActiveSheet.Cells(N + 1, 3) = DataRegion.rsCmConsultaMpio!Cve_loc
AppExcel.ActiveSheet.Cells(N + 1, 4) = DataRegion.rsCmConsultaMpio!Localidad
AppExcel.ActiveSheet.Cells(N + 1, 5) = DataRegion.rsCmConsultaMpio!Escuelas
AppExcel.ActiveSheet.Cells(N + 1, 6) = DataRegion.rsCmConsultaMpio!Inscritos
AppExcel.ActiveSheet.Cells(N + 1, 7) = DataRegion.rsCmConsultaMpio!Existentes
AppExcel.ActiveSheet.Cells(N + 1, 8) = DataRegion.rsCmConsultaMpio!Aprobados_Hom
AppExcel.ActiveSheet.Cells(N + 1, 9) = DataRegion.rsCmConsultaMpio!Aprobados_Muj
DataRegion.rsCmConsultaMpio.MoveNext
N = N + 1
Loop
Set AppExcel = Nothing
Libro.SaveAs (App.Path & "\Milibro.xls")
AppExcel.Visible = False
End Sub
**Exportar a Excel DataGrid2**
Private Sub valores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 12).Borders.LineStyle = xlContinuous
.Cells(1, 1) = "Cve_Mpio"
.Cells(1, 2) = "Municipio"
.Cells(1, 3) = "Escuelas"
.Cells(1, 4) = "Inscritos Hombres"
.Cells(1, 5) = "Inscritos Mujeres"
.Cells(1, 6) = "Inscritos"
.Cells(1, 7) = "Existentes Hombres"
.Cells(1, 8) = "Existentes Mujeres"
.Cells(1, 9) = "Existentes"
.Cells(1, 10) = "Aprobados Hombres"
.Cells(1, 11) = "Aprobados Mujeres"
.Cells(1, 12) = "Aprobados"
.Range(.Cells(1, 1), .Cells(1, 12)).Font.Bold = True
End With
Do While DataRegion.rsCmConsultaTodos.EOF = False
DoEvents
AppExcel.ActiveSheet.Cells(J + 1, 1) = DataRegion.rsCmConsultaTodos!Cve_mpio
AppExcel.ActiveSheet.Cells(J + 1, 2) = DataRegion.rsCmConsultaTodos!Mun
AppExcel.ActiveSheet.Cells(J + 1, 3) = DataRegion.rsCmConsultaTodos!Escuelas
AppExcel.ActiveSheet.Cells(J + 1, 4) = DataRegion.rsCmConsultaTodos!Alum_Insc_H
AppExcel.ActiveSheet.Cells(J + 1, 5) = DataRegion.rsCmConsultaTodos!Alum_Insc_Muj
AppExcel.ActiveSheet.Cells(J + 1, 6) = DataRegion.rsCmConsultaTodos!Inscritos
AppExcel.ActiveSheet.Cells(J + 1, 7) = DataRegion.rsCmConsultaTodos!Alum_Exit_H
AppExcel.ActiveSheet.Cells(J + 1, 8) = DataRegion.rsCmConsultaTodos!Alum_Exist_M
AppExcel.ActiveSheet.Cells(J + 1, 9) = DataRegion.rsCmConsultaTodos!Existentes
AppExcel.ActiveSheet.Cells(J + 1, 10) = DataRegion.rsCmConsultaTodos!Aprobados_Hom
AppExcel.ActiveSheet.Cells(J + 1, 11) = DataRegion.rsCmConsultaTodos!Aprobados_Muj
AppExcel.ActiveSheet.Cells(J + 1, 12) = DataRegion.rsCmConsultaTodos!Aprobados
DataRegion.rsCmConsultaTodos.MoveNext
J = J + 1
Loop
Set AppExcel = Nothing
' 'Libro.SaveAs (App.Path & "\Milibro.xls")
AppExcel.Visible = False
End Sub
Ya que el actual código que le envío si quitamos en el CmdExportar la linea de código Valores, se lleva a cabo sin ningún problema la exportación del primer Grid, pero al activar esa linea me marca el siguiente error: 91 en tiempo de ejecución, variable de tipo Object o la variable de bloque with no esta establecida, al depurar me envía a la linea de código:
Private Sub valores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 30)).Borders.LineStyle = xlContinuous
Mi correo electrónico es [email protected] (Por Favor ayúdeme es lo único que me hace falta para el sistema que desarrollo en mi trabajo, y ya me están presionando para entregarlo)
Este es el código completo.
Private AppExcel As New Excel.Application
Private Sub CmdBuscar_Click()
If DataRegion.rsCmConsultaMpio.State = adStateOpen Then
DataRegion.rsCmConsultaMpio.Close
End If
DataRegion.CmConsultaMpio (DbcProfe.Text)
Set DbgrdMpio.DataSource = DataRegion.rsCmConsultaMpio
End Sub
Private Sub CmdExportar_Click()
AppExcel.Visible = True
AppExcel.Workbooks.Add
'Establecemos la hoja que utilizaremos
AppExcel.SheetsInNewWorkbook = 2
pasavalores
valores
End Sub
Private Sub CmdSalir_Click()
Unload Me
End Sub
Private Sub CmdTodos_Click()
If DataRegion.rsCmConsultaTodos.State = adStateOpen Then
DataRegion.rsCmConsultaTodos.Close
End If
DataRegion.CmConsultaTodos
Set DbgrdCursos.DataSource = DataRegion.rsCmConsultaTodos
End Sub
**Exportar a excel DataGrid1**
Private Sub pasavalores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
.Cells(1, 1) = "Cve. Mpio"
.Cells(1, 2) = "Municipio"
.Cells(1, 3) = "Cve. Loc"
.Cells(1, 4) = "Localidad"
.Cells(1, 5) = "Escuelas"
.Cells(1, 6) = "Inscritos"
.Cells(1, 7) = "Existentes"
.Cells(1, 8) = "Aprobados_Hom"
.Cells(1, 9) = "Aprobados_Muj"
N = 1
.Range(.Cells(1, 1), .Cells(1, 9)).Font. Bold = True
End With
Do While DataRegion.rsCmConsultaMpio.EOF = False
DoEvents
AppExcel.ActiveSheet.Cells(N + 1, 1) = DataRegion.rsCmConsultaMpio!Cve_mpio
AppExcel.ActiveSheet.Cells(N + 1, 2) = DataRegion.rsCmConsultaMpio!Municipio
AppExcel.ActiveSheet.Cells(N + 1, 3) = DataRegion.rsCmConsultaMpio!Cve_loc
AppExcel.ActiveSheet.Cells(N + 1, 4) = DataRegion.rsCmConsultaMpio!Localidad
AppExcel.ActiveSheet.Cells(N + 1, 5) = DataRegion.rsCmConsultaMpio!Escuelas
AppExcel.ActiveSheet.Cells(N + 1, 6) = DataRegion.rsCmConsultaMpio!Inscritos
AppExcel.ActiveSheet.Cells(N + 1, 7) = DataRegion.rsCmConsultaMpio!Existentes
AppExcel.ActiveSheet.Cells(N + 1, 8) = DataRegion.rsCmConsultaMpio!Aprobados_Hom
AppExcel.ActiveSheet.Cells(N + 1, 9) = DataRegion.rsCmConsultaMpio!Aprobados_Muj
DataRegion.rsCmConsultaMpio.MoveNext
N = N + 1
Loop
Set AppExcel = Nothing
Libro.SaveAs (App.Path & "\Milibro.xls")
AppExcel.Visible = False
End Sub
**Exportar a Excel DataGrid2**
Private Sub valores()
With AppExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 12).Borders.LineStyle = xlContinuous
.Cells(1, 1) = "Cve_Mpio"
.Cells(1, 2) = "Municipio"
.Cells(1, 3) = "Escuelas"
.Cells(1, 4) = "Inscritos Hombres"
.Cells(1, 5) = "Inscritos Mujeres"
.Cells(1, 6) = "Inscritos"
.Cells(1, 7) = "Existentes Hombres"
.Cells(1, 8) = "Existentes Mujeres"
.Cells(1, 9) = "Existentes"
.Cells(1, 10) = "Aprobados Hombres"
.Cells(1, 11) = "Aprobados Mujeres"
.Cells(1, 12) = "Aprobados"
.Range(.Cells(1, 1), .Cells(1, 12)).Font.Bold = True
End With
Do While DataRegion.rsCmConsultaTodos.EOF = False
DoEvents
AppExcel.ActiveSheet.Cells(J + 1, 1) = DataRegion.rsCmConsultaTodos!Cve_mpio
AppExcel.ActiveSheet.Cells(J + 1, 2) = DataRegion.rsCmConsultaTodos!Mun
AppExcel.ActiveSheet.Cells(J + 1, 3) = DataRegion.rsCmConsultaTodos!Escuelas
AppExcel.ActiveSheet.Cells(J + 1, 4) = DataRegion.rsCmConsultaTodos!Alum_Insc_H
AppExcel.ActiveSheet.Cells(J + 1, 5) = DataRegion.rsCmConsultaTodos!Alum_Insc_Muj
AppExcel.ActiveSheet.Cells(J + 1, 6) = DataRegion.rsCmConsultaTodos!Inscritos
AppExcel.ActiveSheet.Cells(J + 1, 7) = DataRegion.rsCmConsultaTodos!Alum_Exit_H
AppExcel.ActiveSheet.Cells(J + 1, 8) = DataRegion.rsCmConsultaTodos!Alum_Exist_M
AppExcel.ActiveSheet.Cells(J + 1, 9) = DataRegion.rsCmConsultaTodos!Existentes
AppExcel.ActiveSheet.Cells(J + 1, 10) = DataRegion.rsCmConsultaTodos!Aprobados_Hom
AppExcel.ActiveSheet.Cells(J + 1, 11) = DataRegion.rsCmConsultaTodos!Aprobados_Muj
AppExcel.ActiveSheet.Cells(J + 1, 12) = DataRegion.rsCmConsultaTodos!Aprobados
DataRegion.rsCmConsultaTodos.MoveNext
J = J + 1
Loop
Set AppExcel = Nothing
' 'Libro.SaveAs (App.Path & "\Milibro.xls")
AppExcel.Visible = False
End Sub
3 respuestas
Respuesta
1
Respuesta de orande
1
Respuesta de xabi
1