Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Public Class frmBlPartnerUebersicht #Region "Deklarationen" Dim bpdaten As New DataTable Dim Dokumente As New DataTable Dim Aushaendigungen As New DataTable Dim DefPeriode As New DataTable Dim OnLoad As Boolean = True #End Region #Region "Formular" Private Sub SchliessenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SchliessenToolStripMenuItem.Click Me.Close() End Sub Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick Select Case ToolBar1.Buttons.IndexOf(e.Button) Case 0 'Exit Me.SchliessenToolStripMenuItem_Click(sender, e) Case 1 Me.SaveFileDialog1.AddExtension = True Me.SaveFileDialog1.DefaultExt.Insert(0, "*.xls") Me.SaveFileDialog1.Filter = "Excel-Dateien|*.xls" Me.SaveFileDialog1.ShowDialog() If Me.SaveFileDialog1.FileName <> "" Then If Me.SaveFileDialog1.FileName.EndsWith("xls") Then Me.DatatableToExcel(Me.bpdaten, Me.SaveFileDialog1.FileName) End If End If Case 2 Me.SaveFileDialog1.AddExtension = True Me.SaveFileDialog1.DefaultExt.Insert(0, "*.xls") Me.SaveFileDialog1.Filter = "Excel-Dateien|*.xls" Me.SaveFileDialog1.ShowDialog() If Me.SaveFileDialog1.FileName <> "" Then If Me.SaveFileDialog1.FileName.EndsWith("xls") Then Me.DatatableToExcel(Me.Dokumente, Me.SaveFileDialog1.FileName) End If End If Case 3 End Select End Sub Private Sub frmBlPartnerUebersicht_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'Try ' Me.Cursor = Cursors.WaitCursor ' Application.DoEvents() ' Me.bpdaten = Me.Get_BLPartner(1) ' Me.lbblpartner.DataSource = Me.bpdaten ' Me.lbblpartner.DisplayMember = "Partner" 'Catch ex As Exception 'Finally ' Me.Cursor = Cursors.Default 'End Try Me.OnLoad = False Me.ComboBox1.SelectedIndex = 0 End Sub Private Sub lbblpartner_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbblpartner.SelectedIndexChanged Try Me.Cursor = Cursors.WaitCursor Dim s As String = Me.bpdaten.Rows(Me.lbblpartner.SelectedIndex).Item(0).ToString Dim i As Integer Dim pnr As Integer i = s.IndexOf("-") pnr = s.Substring(0, i - 1) pnr = Trim(pnr) Me.Dokumente = Get_Dokumente(pnr) Me.Aushaendigungen = Get_Aushaendigungen(pnr) Me.DefPeriode = Get_Periode(pnr) Me.DokList.Enabled = False Me.DokList.BeginInit() Me.DokList.DataSource = Me.Dokumente Me.DokList.DataMember = Me.Dokumente.TableName DivFnkt.SpaltenTitel_Aktualisieren(Me.DokList, Me.Dokumente, "bldossier") Me.DokList.EndInit() Me.DokList.Enabled = True Me.C1Aushaendigungen.Enabled = False Me.C1Aushaendigungen.BeginInit() Me.C1Aushaendigungen.DataSource = Me.Aushaendigungen Me.C1Aushaendigungen.DataMember = Me.Aushaendigungen.TableName Try DivFnkt.SpaltenTitel_Aktualisieren(Me.C1Aushaendigungen, Me.Aushaendigungen, "Aushaendigung") Catch ex As Exception End Try Me.C1Aushaendigungen.EndInit() Me.C1Aushaendigungen.Enabled = True Me.C1DefPeriode.Enabled = False Me.C1DefPeriode.BeginInit() Me.C1DefPeriode.DataSource = Me.DefPeriode Me.C1DefPeriode.DataMember = Me.DefPeriode.TableName DivFnkt.SpaltenTitel_Aktualisieren(Me.C1DefPeriode, Me.DefPeriode, "BLPeriode") Me.C1DefPeriode.EndInit() Me.C1DefPeriode.Enabled = True Catch ex As Exception Me.C1DefPeriode.DataSource = Nothing Me.C1Aushaendigungen.DataSource = Nothing Me.DokList.DataSource = Nothing Finally Me.Cursor = Cursors.Default End Try End Sub #End Region #Region "Export to Excel" Public Shared Function DatatableToExcel(ByVal aDataTable As DataTable, ByVal aOutputFilename As String) As Boolean Application.DoEvents() Dim f As New FrmFortschritt Dim app As New Object Dim wb As New Object Dim ws As New Object Try f.Show() Application.DoEvents() f.ProgressBar1.Minimum = 0 f.ProgressBar1.Maximum = aDataTable.Rows.Count app = CreateObject("Excel.application") 'Dim wb As Object 'Dim ws As Object ' Dim app As New Excel.ApplicationClass ' Dim wb As Excel.Workbook ' Dim ws As Excel.Worksheet wb = app.Workbooks.add() 'wb = app.Workbooks.Add() ws = wb.ActiveSheet() Dim dc As DataColumn Dim dr As DataRow Dim colIndex As Integer Dim rowIndex As Integer ' Columns erstellen For Each dc In aDataTable.Columns colIndex += 1 app.Cells(1, colIndex) = dc.ColumnName Next ' Rows hinzufügen For Each dr In aDataTable.Rows f.ProgressBar1.Value = rowIndex rowIndex += 1 colIndex = 0 For Each dc In aDataTable.Columns colIndex += 1 app.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName) Next Next ws.Columns.AutoFit() wb.SaveAs(aOutputFilename) app.Workbooks.Open(aOutputFilename) ' Excel anzeigen wenn fertig exportiert app.Visible = True ws = Nothing wb = Nothing app = Nothing f.Close() Return True Catch ex As Exception f.Close() MsgBox(ex.Message) End Try End Function #End Region #Region "Daten" Private Function Get_BLPartner(ByVal type As Integer, Optional ByVal jahre As Integer = 0) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_edex_bl_get_blbpList" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@type", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, type)) scmCmdToExecute.Parameters.Add(New SqlParameter("@Jahre", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Jahre)) sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Function Get_Dokumente(ByVal pnr As Integer) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_edex_bl_get_dossier" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, pnr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@filter", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Function Get_Aushaendigungen(ByVal pnr As Integer) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_edex_bl_get_auslieferungen_des_partners_komplett" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@nrpar00", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, pnr)) sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Function Get_Periode(ByVal pnr As Integer) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.sp_edex_bl_get_peridata" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@blkundenr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, pnr)) sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function #End Region Private Sub QuittungAnzeigenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles QuittungAnzeigenToolStripMenuItem.Click Try DivFnkt.ShowDoc(Me.C1Aushaendigungen.Columns("Dokumentid_Quittung").Value, Me) Catch ex As Exception End Try End Sub Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged If OnLoad Then Exit Sub Me.ComboBox2.Visible = False Me.lblaelterals.Visible = False Me.lbljahre.Visible = False Select Case ComboBox1.Text Case "Alle Partner" Me.bpdaten = Me.Get_BLPartner(1) Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case "BP mit Aushändigung(en)" Me.bpdaten = Me.Get_BLPartner(2) Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case "BP ohne Aushändigung" Me.bpdaten = Me.Get_BLPartner(3) Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case "BP mit nicht ausgelieferten Dokumenten" Me.ComboBox2.Visible = True Me.lblaelterals.Visible = True Me.lbljahre.Visible = True Me.ComboBox2.SelectedIndex = 0 If Me.ComboBox2.Text = "0 (alle)" Then Me.bpdaten = Me.Get_BLPartner(4, 0) Else Me.bpdaten = Me.Get_BLPartner(4, Me.ComboBox2.Text) End If Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case "Saldierte BP mit nicht ausgelieferten Dokumenten" Me.bpdaten = Me.Get_BLPartner(6) Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case "BP mit aktiven periodischen Auslieferungen" Me.bpdaten = Me.Get_BLPartner(7) Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" Case Else Me.Get_BLPartner(1) End Select End Sub Private Sub C1DefPeriode_FetchRowStyle(ByVal sender As Object, ByVal e As C1.Win.C1TrueDBGrid.FetchRowStyleEventArgs) Handles C1DefPeriode.FetchRowStyle Dim dtvon As Date Dim dtbis As Date dtvon = Me.C1DefPeriode.Columns("erstmals_am").CellValue(e.Row) dtbis = Me.C1DefPeriode.Columns("ende").CellValue(e.Row) If dtvon > Now Then Dim FNT As Font = e.CellStyle.Font e.CellStyle.BackColor = Color.Green End If If dtbis < Now Then Dim FNT As Font = e.CellStyle.Font e.CellStyle.Font = New Font(FNT, FontStyle.Strikeout) e.CellStyle.ForeColor = Color.Gray End If End Sub Private Sub ComboBox2_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox2.SelectedIndexChanged Me.C1DefPeriode.DataSource = Nothing Me.C1Aushaendigungen.DataSource = Nothing Me.DokList.DataSource = Nothing If Me.ComboBox2.Text = "0 (alle)" Then Me.bpdaten = Me.Get_BLPartner(4, 0) Else Me.bpdaten = Me.Get_BLPartner(4, Me.ComboBox2.Text) End If Me.lbblpartner.DataSource = Me.bpdaten Me.lbblpartner.DisplayMember = "Partner" End Sub End Class