Imports System.Text.RegularExpressions Imports DevExpress.Spreadsheet Imports DevExpress.Xpf.Core Imports DevExpress.Xpf.Docking Imports DevExpress.XtraReports.UI Imports Microsoft.Win32 Imports System.IO Public Class InformesGenerico Public Shared Sub ExcelAInforme(Titulo As String, Fichero As Byte(), GrupoDocumentos As DocumentGroup, dc As DockController, Optional FicheroDestino As String = Nothing, Optional Parametros As Hashtable = Nothing, Optional MostrarPanelParametros As Boolean = False) Dim s As String = System.Text.Encoding.UTF8.GetString(Fichero) Using sw As New StreamWriter(New MemoryStream()) sw.Write(s) sw.Flush() Try Dim xr = XtraReport.FromStream(sw.BaseStream, True) ExcelAInforme(Titulo, xr, GrupoDocumentos, dc, FicheroDestino, Parametros, MostrarPanelParametros) Catch ex As Reflection.ReflectionTypeLoadException Dim sLista As String sLista = "" For Each item In ex.LoaderExceptions sLista &= item.Message & vbCrLf If item.InnerException IsNot Nothing Then sLista &= item.InnerException.Message & vbCrLf End If Next MsgBox(sLista) End Try End Using End Sub Public Shared Sub ExcelAInforme(Titulo As String, xr As XtraReport, GrupoDocumentos As DocumentGroup, dc As DockController, Optional FicheroDestino As String = Nothing, Optional Parametros As Hashtable = Nothing, Optional MostrarPanelParametros As Boolean = False) Dim fb As New OpenFileDialog fb.Filter = "Fichero Excel (*.xls, *.xlsx, *.csv)|*.xls;*.xlsx;*.csv" fb.DefaultExt = ".xls" If fb.ShowDialog Then Dim Rango As String Dim FilaInicio, FilaFin As Integer Do Try Rango = InputBox("Introduzca Rango de filas", "Rango de Filas", "2-10") If Rango = "" Then Exit Do If Rango <> "" Then If Rango.Split("-").Length <> 2 Then Throw New Exception("Rango Incorrecto") Dim sInicio As String = Rango.Split("-")(0) If Not IsValid(sInicio) Then Throw New Exception("Rango Incorrecto") Dim sFin As String = Rango.Split("-")(1) If Not IsValid(sFin) Then Throw New Exception("Rango Incorrecto") FilaInicio = Integer.Parse(Rango.Split("-")(0)) FilaFin = Integer.Parse(Rango.Split("-")(1)) If FilaInicio > FilaFin Then Throw New Exception("Rango Incorrecto") End If Exit Do Catch ex As Exception DXMessageBox.Show("Rango incorrecto", "Error") End Try Loop If Rango <> "" Then Dim wb As New Workbook Dim datos As New List(Of FilaExcel) Select Case fb.FileName.Split(".").Last.ToLower Case "xls" wb.LoadDocument(fb.FileName, DevExpress.Spreadsheet.DocumentFormat.Xls) Case "xlsx" wb.LoadDocument(fb.FileName, DevExpress.Spreadsheet.DocumentFormat.Xlsx) Case "csv" wb.LoadDocument(fb.FileName, DevExpress.Spreadsheet.DocumentFormat.Csv) End Select For i = FilaInicio To FilaFin Dim reg As New FilaExcel For l = 65 To 90 Dim valor As String = wb.Worksheets(0).Cells(Chr(l) & i.ToString).Value.ToString reg.GetType.GetProperty(Chr(l)).SetValue(reg, valor, Nothing) Next datos.Add(reg) Next MuestraImpresos(Titulo, xr, datos, GrupoDocumentos, dc, FicheroDestino, Parametros, MostrarPanelParametros) End If End If End Sub Shared Function IsValid(ByVal inputString As String) As Boolean Dim validValues As New Regex("^[1-9]?[0-9]{1}$|^100000$") Return validValues.IsMatch(inputString) End Function Public Shared Sub MuestraImpresos(Titulo As String, Fichero As Byte(), Datasource As Object, GrupoDocumentos As DocumentGroup, dc As DockController, Optional FicheroDestino As String = Nothing, Optional Parametros As Hashtable = Nothing, Optional MostrarPanelParametros As Boolean = False) Dim s As String = System.Text.Encoding.UTF8.GetString(Fichero) Using sw As New StreamWriter(New MemoryStream()) sw.Write(s) sw.Flush() Try Dim xr = XtraReport.FromStream(sw.BaseStream, True) MuestraImpresos(Titulo, xr, Datasource, GrupoDocumentos, dc, FicheroDestino, Parametros, MostrarPanelParametros) Catch ex As Reflection.ReflectionTypeLoadException Dim sLista As String sLista = "" For Each item In ex.LoaderExceptions sLista &= item.Message & vbCrLf If item.InnerException IsNot Nothing Then sLista &= item.InnerException.Message & vbCrLf End If Next MsgBox(sLista) End Try End Using End Sub Public Shared Sub MuestraImpresos(Titulo As String, xr As XtraReport, Datasource As Object, GrupoDocumentos As DocumentGroup, dc As DockController, Optional FicheroDestino As String = Nothing, Optional Parametros As Hashtable = Nothing, Optional MostrarPanelParametros As Boolean = False) Try Try Dim pr As DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = "Fecha").First pr.Value = Now pr.Visible = False Catch ex As Exception End Try If Parametros IsNot Nothing Then For Each pm As DictionaryEntry In Parametros Try Dim pr As DevExpress.XtraReports.Parameters.Parameter = (From p As DevExpress.XtraReports.Parameters.Parameter In xr.Parameters Where p.Name = pm.Key).First pr.Value = pm.Value Catch ex As Exception Debug.Write(ex.Message) End Try Next End If xr.DataSource = Datasource If FicheroDestino <> "" Then Select Case FicheroDestino.Split(".").Last.ToLower Case "pdf" xr.ExportToPdf(FicheroDestino) Case "xls" xr.ExportToXls(FicheroDestino) Case "xlsx" xr.ExportToXlsx(FicheroDestino) Case "csv" xr.ExportToXlsx(FicheroDestino) End Select Else ''Dim docpanel As New DevExpress.Xpf.Docking.DocumentPanel ''docpanel.Caption = Titulo ''Dim modelo As New tsWPFCore.tsXtraReportPreviewModel(xr) ''modelo.IsParametersPanelVisible = MostrarPanelParametros ''modelo.AutoShowParametersPanel = MostrarPanelParametros ''xr.RequestParameters = MostrarPanelParametros ''Dim vi As New tsWPFCore.ucVisualizadorInformesa() ''vi.Visualizador.Model = modelo ''xr.CreateDocument(True) ''docpanel.Content = vi ''docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove ''GrupoDocumentos.Items.Add(docpanel) ''dc.Activate(docpanel) 'Dim modelo As New tsWPFCore.tsXtraReportPreviewModel(xr) 'Dim link As New PrintableControlLink(modelo) 'link.PaperKind = System.Drawing.Printing.PaperKind.A4 'link.Landscape = True 'link.Margins.Left = 0.5 'link.Margins.Right = 0.5 'link.Margins.Bottom = 0.5 'link.Margins.Top = 0.5 'Dim vi As New ucVisualizadorInformes() 'link.PageHeaderTemplate = DirectCast(vi.Resources("pageHeaderTemplate"), DataTemplate) 'link.PageFooterTemplate = DirectCast(vi.Resources("pageFooterTemplate"), DataTemplate) 'link.CreateDocument() 'vi.Visualizador.DocumentSource = link 'Dim docpanel = New DevExpress.Xpf.Docking.DocumentPanel 'Dim tabHeaderPrintInfoControl As New TabHeaderPrintInfoControl() With {.TabName = Titulo} 'docpanel.Caption = tabHeaderPrintInfoControl 'docpanel.Content = vi 'docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove 'GrupoDocumentos.Add(docpanel) 'Comun.dm.DockController.Activate(docpanel) End If Catch ex As Exception DXMessageBox.Show(ex.Message & vbCrLf & ex.ToString & vbCrLf & ex.StackTrace, "Atención", MessageBoxButton.OK, MessageBoxImage.Error) Finally End Try End Sub End Class Public Class FilaExcel Property A As String Property B As String Property C As String Property D As String Property E As String Property F As String Property G As String Property H As String Property I As String Property J As String Property K As String Property L As String Property M As String Property N As String Property O As String Property P As String Property Q As String Property R As String Property S As String Property T As String Property U As String Property V As String Property W As String Property X As String Property Y As String Property Z As String End Class