Bueno el proyecto consta de abrir un DataReport enviando los datos desde un Grid1, pero sin usar una tabla, les dejo el codigo del proyecto.
el cual ocupa los siguientes objetos command1, command2, y un Msflexgrid1
Aqui el codigo del Form_Load
Código:
Les dejo el codigo del command1 (el cual funciona muy bien)Private Sub Form_Load() Dim Tempo As Integer Dim Otro As Integer Grid1.FormatString = "No.|Nombre|Apellido paterno|Apellido materno" For Tempo = 0 To 10 Grid1.AddItem "No." + Str(Tempo) + vbTab + "Nombre" + Str(Tempo) + vbTab + "Apellido paterno" + Str(Tempo) + vbTab + "Apellido materno" + Str(Tempo) Next Tempo Grid1.RemoveItem 1 End Sub
Código:
Aca el codigo del command2 (que es donde me manda el error)Private Sub Command1_Click()
On Error GoTo ErrSub
Dim El_Recordset As Recordset ' Variable para el recordset
Set El_Recordset = New Recordset ' Nuevo objeto Recordset desconectado
With El_Recordset.Fields ' Crea cuatro campos, tres de tipo String y uno de tipo Date
.Append "Nombre", adVarChar, 50
.Append "Apellido", adVarChar, 50
.Append "Localidad", adVarChar, 50
.Append "Fecha", adDate
End With
' Abre el recorset para poder agregar datos
El_Recordset.Open
' Agrega valores al recordset, es decir a los campos
'********************************************************************
With El_Recordset
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Carlos", "Perez", "Mar del plata", "02/02/1988")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Maria", "Suares", "Buenos aires", "13/02/1997")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Pedro", "Villegas", "Comodoro", "22/11/1981")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Juan Martín", "Molina", "Bahia Blanca", "02/02/1988")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Jimena", "Solis", "Carlos paz", "03/15/1982")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Rosario", "Rodrigues", "Gualeguaychu", "10/05/1985")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Juan Pablo", "Perez", "Santa Fe", "24/04/1987")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> Federico", "García", "Iguazú", "06/08/1988")
.AddNew Array("Nombre", "Apellido", "Localidad", "Fecha"), _
Array("> José", "Hernandez", "La plata", "25/12/2002")
End With
'********************************************************************
' Asigna el recordset como fuente de datos del DataReport
Set DataReport1.DataSource = El_Recordset
' Carga y muestra el Datareport
DataReport1.Show
'Cierra el recorset
If Not El_Recordset.State = adStateOpen Then
El_Recordset.Close
End If
'Elimina la variable del recordsert
If Not El_Recordset Is Nothing Then
Set El_Recordset = Nothing
End If
Exit Sub
' Error
ErrSub:
MsgBox " Número de error: " & Err.Number & vbNewLine & _
Err.Description, vbCritical
End Sub
Código:
y Aca la funcion a la cual se hace referenciaPrivate Sub Command2_Click() ImprimeGrid Grid1, DataReport1 End Sub
Código:
Private Function ImprimeGrid(xGrid As MSFlexGrid, xReport As DataReport)
'On Error GoTo ErrSub
Dim Tempo As Integer
Dim Otro As Integer
Dim Encabezado() As String
Dim Campo() As String
Dim Encabezados As String
Dim Campos As String
Dim Indice As Integer
Dim Espacio As Integer
Dim El_Recordset As Recordset 'Variable para el recordset
Set El_Recordset = New Recordset 'Nuevo objeto Recordset desconectado
Indice = 0
For Tempo = 0 To xGrid.Cols - 1
If xGrid.ColWidth(Tempo) > 0 Then Indice = Indice + 1
Next Tempo
ReDim Encabezado(0 To Indice - 1)
ReDim Campo(0 To Indice - 1)
Encabezados = ""
With El_Recordset.Fields 'Crea los campos, de tipo String, con tamaño variable
Indice = 0
For Tempo = 0 To xGrid.Cols - 1
If xGrid.ColWidth(Tempo) > 0 Then
Espacio = 0
For Otro = 1 To xGrid.Rows - 1
If Espacio < Len(xGrid.TextMatrix(Otro, Tempo)) Then Espacio = Len(xGrid.TextMatrix(Otro, Tempo)) + 2
Next Otro
Encabezado(Indice) = Trim(Replace(Replace(xGrid.TextMatrix(0, Tempo), ".", ""), " ", "")) + vbNullString
'.Append Encabezado(Indice), adVarChar, Espacio
.Append Encabezado(Indice), adVarChar, Espacio + 2
Indice = Indice + 1
End If
If Encabezados <> "" Then Encabezados = Encabezados + ", "
Encabezados = Encabezados + """" + Encabezado(Indice - 1) + """"
Next Tempo
'Encabezados = Encabezados + vbNullString
'MsgBox "_" + Encabezados + "_"
'Encabezados = Replace(Encabezados, """""", """")
'MsgBox "_" + Encabezados + "_"
End With
El_Recordset.Open 'Abre el recorset para poder agregar datos
'********************************************************************
With El_Recordset 'Agrega valores al recordset, es decir a los campos
For Tempo = 1 To xGrid.Rows - 1
If xGrid.ColWidth(0) > 0 Then
Indice = 0
Campos = ""
For Otro = 0 To xGrid.Cols - 1
If Campos <> "" Then Campos = Campos + ", "
Campos = Campos + """" + Trim(Grid1.TextMatrix(Tempo, Otro)) + " " + vbNullString + """"
'Campo(Indice) = Trim(xGrid.TextMatrix(Tempo, Otro)) + vbNullString
'If Indice = 1 Then Campo(Indice) = ">" + Campo(Indice)
'Indice = Indice + 1
Next Otro
.AddNew Array(Encabezados), Array(Campos)
End If
Next Tempo
End With
'********************************************************************
Set DataReport1.DataSource = El_Recordset 'Asigna el recordset como fuente de datos del DataReport
DataReport1.Orientation = rptOrientLandscape 'Alinea la orientacion de la pagina
DataReport1.Show 'Carga y muestra el Datareport
If Not El_Recordset.State = adStateOpen Then El_Recordset.Close 'Cierra el recorset
If Not El_Recordset Is Nothing Then Set El_Recordset = Nothing 'Elimina la variable del recordsert
Exit Function
ErrSub: ' Error
MsgBox "Número de error: " & Err.Number & vbCrLf & Err.Description, vbCritical
End Function
Segun eso es para generar una tabla, y mandarla al DataReport sin tener que pasar por una tabla, ya que todo el proceso de ordenamiento y demas cosas se haria en el grid ;)
de antemando agradesco su valiosa ayuda.
