datareport

Carlos Esquivel
23 de Junio del 2004
hola una consulta tengo un proyecto hecho en visual basic y sql, tengo reportes hechos en datareport pero el problema es como exporto a excel , he fijado en la opcion de exportar en datareport pero no aparece la lista de archivos en esa opcion la extension de *.xls. como puedo hacerlo
le agradecere su gentil ayuda, asesoramiento o respuesta

Oscar Armando Sanchez Toro
23 de Junio del 2004
mira lo que pasa que el datareport es muy limitado, solo te permite exportar a los formatos que te sale en la lista. pero si quieres exportar estos datos a excel, tienes que hacerlo atraves de codigo que habra el excel y dentro del ciclo del recordset empiece a escribir en el excel , si quieres me escribes o entra al messenger y te colaboro. messeenger es: [email protected] es el mismo del correo.

saludos . bogotá-colombia

Meifer
23 de Junio del 2004
Hola yo lo he hecho pero con Crystal Report.... si quieres visita esta web http://www.lawebcrystal.com

Oscar Armando Sanchez Toro
23 de Junio del 2004
messenger: [email protected]

aqui esta el codigo:

'procedimiento generado por oscar armando sanchez toro
'DESARROLLADOR DE SOFTWARE Y DE REDES BOGOTA-COLOMBIA
'MESSENGER --> [email protected]
'CORREO --> [email protected]

'esto es para maquillar la exportada a excel
Dim ApExcel As Variant
Dim D As String
Dim X, R As Integer
Dim Contador, TotalReg
'
Dim rsExportar As ADODB.Recordset
Set rsExportar = New ADODB.Recordset
Set rsExportar.DataSource = rsDatos.Clone 'AQUI COLOCAS EL RECORDSET PARA QUE EL SISTEMA LO IGUALE EJ. ENVES DE RSDATOS COLOCAS EL NOMBRE DE TU RECORSET
'Mueve el recorset al 1. registros
On Error GoTo Etiqueta
Screen.MousePointer = 11
Contador = 0
Y=2
rsExportar.MoveFirst
Set ApExcel = CreateObject("Excel.application")
' Hace que Excel se vea
With ApExcel
.Visible = True
.WindowState = xlMinimized
'Agrega un nuevo Libro
.Workbooks.Add
'Procedimiento para maquillar el excel
'COLOCA TITULO
ApExcel.Range("" & IniTitulo & "").Value = Titulo 'AQUI INICIAL LA COLUMNA COLOCAS O REEMPLAZAS DIRECTAMENTE LA VARIABLE EJ. A1 O Initiutlo="A1"
ApExcel.Range("" & IniTitulo & "").Font.Size = 16
ApExcel.Range("" & IniTitulo & "").Font.Color = vbRed
'CENTRA TITULO EN LAS COLUMNAS
ApExcel.Range(" " & IniTitulo & " " & ":" & "" & FinTitulo & " ").Select 'LOS MISMO IGUALAS LA VARIBALES O REEMPLAZAS, TAMBIEN OTRA VARIABLE DONDE FINALIZA EL COLUMNA EJ: "AZ"
With ApExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
'CENTRA LOS TITULO DE LAS COLUMNAS Y COLOCA NEGRILLA
ApExcel.Selection.Merge
ApExcel.Range(" " & IniImpre & " " & ":" & "" & FinImpre & " ").Select 'VARIABLES DONDE EMPIEZA LA COLUMNA EJ "A2" Y FIN "AZ"
With ApExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
.Font.Bold = True
End With
'COLOCA COLOR AMARILLO EN LOS TITULOS
With ApExcel.Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
'COLOCA BORDE EN LOS TITULOS
ApExcel.Range(" " & IniImpre & " " & ":" & "" & FinImpre & " ").Borders.Color = RGB(255, 0, 0)
'fin
Forma.lblMensaje.Caption = "Exportando..."
'Imprime los titulo
For X = 1 To rsExportar.Fields.Count
.Cells(Y, X).Formula = rsExportar.Fields(X - 1).Name
DoEvents
Next
'Empienza a imprimir en las columnas
Do Until rsExportar.EOF
Y = Y + 1
For X = 1 To rsExportar.Fields.Count
' Debug.Print X & "/" & Y & "/" & rsExportar.Fields(X - 1).Name
'<=Z
'VALIDACIÓN CUANDO LA COLUMNA SUPERAN LA AAZ
If rsExportar.Fields(X - 1) <> "" Then
If X < 27 Then 'A HASTA LA Z
D = Chr(X + 64) & Y
.Range(D).Formula = CStr(rsExportar.Fields(X - 1))
ElseIf X > 26 And X < 52 Then '>=AA HASTA Z
R = X - 26
D = (Chr(65) & Chr(R + 64)) & Y
.Range(D).Formula = CStr(rsExportar.Fields(X - 1))
Else '>=BB HASTA BBZ
R = X - 52
D = (Chr(66) & Chr(R + 65)) & Y
.Range(D).Formula = CStr(rsExportar.Fields(X - 1))
End If
End If
DoEvents
Next
Contador = Contador + 1
.Caption = "Exportando: " & Contador & " : " & rsExportar.RecordCount
rsExportar.MoveNext
DoEvents
Loop
.Caption = "Ayuda en linea con Oscar Armando Sanchez messenger/Correo: [email protected] Bogotà-Colombia"
'Impriem la cantidad de registros
ApExcel.Range("" & Mid(IniTitulo, 1, 1) & "" & Y + 2).Value = "Total Registros : " & rsExportar.RecordCount
ApExcel.Range("" & Mid(IniTitulo, 1, 1) & "" & Y + 2).Font.Bold = True
ApExcel.Range("" & Mid(IniTitulo, 1, 1) & "" & Y + 3).Value = "Fecha de Proceso: " & Format(Date, "dd/mmmm/yyyy")
ApExcel.Range("" & Mid(IniTitulo, 1, 1) & "" & Y + 3).Font.Bold = True
End With
Set ApExcel = Nothing
Screen.MousePointer = 0
Exit Function
Etiqueta:
If Err.Number = 429 Then
MsgBox "Su PC no tiene instalado Excel", vbInformation, "ERROR"
Else
MsgBox Err.Description, vbCritical,"ERROR"
End If
Screen.MousePointer = 0