Imports System Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Public Class frmLifeCiclyReporting Public imglist As New ImageList Dim clslc As New TKB.VV.Lifecycle.clslifeCycle Dim produkte As New TKB.VV.Lifecycle.clsProdukt Dim phase As New TKB.VV.Lifecycle.clslcProduktPhase Dim OnLoad As Boolean = True Dim IDVAuswertungen As New DataTable Private Sub TSBtnQuit_Click(sender As Object, e As EventArgs) Handles TSBtnQuit.Click Me.Close() End Sub Private Sub frmLifeCiclyReporting_Load(sender As Object, e As EventArgs) Handles MyBase.Load Get_Phasen() get_idvauswertungen() clslc.Get_Produktliste() Me.chkLBProdukte.CheckOnClick = True Me.chklbPhasen.CheckOnClick = True For Each r As DataRow In PhaseStammdaten.Rows Me.chklbPhasen.Items.Add(r("Bezeichnung")) Next For Each r As DataRow In clslc.Produkte.Rows Me.chkLBProdukte.Items.Add(r("Bezeichnung")) Next Me.cbboxEntscheidungInTagen.SelectedText = 10 Me.cbboxProdukteInTagen.SelectedText = 10 Me.cbboxUeberpruefungInTagen.SelectedText = 10 Me.txtvon.Text = Now.ToString Me.txtvon1.Text = Now.ToString Me.cbboxProdukttyp.DataSource = clslc.Produkttypen_Copy Me.cbboxProdukttyp.DisplayMember = "Bezeichnung" Me.cbboxProdukttyp.ValueMember = "LC_Produkttypnr" Me.cbboxProdukttyp1.DataSource = clslc.Produkttypen_Copy1 Me.cbboxProdukttyp1.DisplayMember = "Bezeichnung" Me.cbboxProdukttyp1.ValueMember = "LC_Produkttypnr" Me.cbboxidvauswertungen.DataSource = Me.IDVAuswertungen Me.cbboxidvauswertungen.DisplayMember = "Bezeichnung" Me.cbboxidvauswertungen.ValueMember = "lc_sqlnr" OnLoad = False End Sub Private Sub dtvon1_ValueChanged(sender As Object, e As EventArgs) Handles dtvon1.ValueChanged Me.txtvon1.Text = Me.dtvon1.Text End Sub Private Sub dtbis1_ValueChanged(sender As Object, e As EventArgs) Handles dtbis1.ValueChanged Me.txtbis1.Text = Me.dtbis1.Text End Sub Private Sub dtvon_ValueChanged(sender As Object, e As EventArgs) Handles dtvon.ValueChanged Me.txtvon.Text = Me.dtvon.Text End Sub Private Sub dtbis_ValueChanged(sender As Object, e As EventArgs) Handles dtbis.ValueChanged Me.txtbis.Text = Me.dtbis.Text End Sub #Region "Phasen" Dim PhaseStammdaten As New DataTable Sub Get_Phasen() Try Me.PhaseStammdaten.Rows.Clear() Dim Connection As New SqlConnection(Globals.sConnectionString) Dim DA As New SqlDataAdapter("select * from lc_phase where aktiv=1 order by bezeichnung", Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) DA.Fill(PhaseStammdaten) Catch End Try End Sub #End Region Private Sub btnUeberpruefungAbgelaufen_Click(sender As Object, e As EventArgs) Handles btnUeberpruefungAbgelaufen.Click Me.C1Result.DataSource = Nothing Get_Reportdata(1) Me.C1Result.DataSource = Reportdata End Sub Private Sub btnUeberpruefungInTagen_Click(sender As Object, e As EventArgs) Handles btnUeberpruefungInTagen.Click Me.C1Result.DataSource = Nothing Get_Reportdata(2) Me.C1Result.DataSource = Reportdata End Sub Private Sub btnEntscheidungAbgelaufen_Click(sender As Object, e As EventArgs) Handles btnEntscheidungAbgelaufen.Click Me.C1Result.DataSource = Nothing Get_Reportdata(3) Me.C1Result.DataSource = Reportdata End Sub Private Sub btnEntscheidungInTagen_Click(sender As Object, e As EventArgs) Handles btnEntscheidungInTagen.Click Me.C1Result.DataSource = Nothing Get_Reportdata(4) Me.C1Result.DataSource = Reportdata End Sub Dim selProdukte As String = "" Dim selDatumvon As String = "" Dim selDatumbis As String = "" Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click Dim i As Integer selProdukte = "" For i = 0 To Me.chklbPhasen.CheckedItems.Count - 1 For Each r As DataRow In PhaseStammdaten.Rows If r("bezeichnung") = Me.chklbPhasen.CheckedItems(i) Then If selProdukte <> "" Then selProdukte = selProdukte + "," selProdukte = selProdukte + r("lc_phasenr").ToString End If Next Next Me.C1Result.DataSource = Nothing If Me.txtvon.Text = " . ." Then selDatumvon = "" Else selDatumvon = Me.txtvon.Text If Me.txtbis.Text = " . ." Then selDatumbis = "" Else selDatumbis = Me.txtbis.Text Get_Reportdata(7) Me.C1Result.DataSource = Reportdata End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim i As Integer selProdukte = "" For i = 0 To Me.chklbPhasen.CheckedItems.Count - 1 For Each r As DataRow In PhaseStammdaten.Rows If r("bezeichnung") = Me.chklbPhasen.CheckedItems(i) Then If selProdukte <> "" Then selProdukte = selProdukte + "," selProdukte = selProdukte + r("lc_phasenr").ToString End If Next Next Me.C1Result.DataSource = Nothing If Me.txtvon.Text = " . ." Then selDatumvon = "" Else selDatumvon = Me.txtvon.Text If Me.txtbis.Text = " . ." Then selDatumbis = "" Else selDatumbis = Me.txtbis.Text Get_Reportdata(5) Me.C1Result.DataSource = Reportdata End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim i As Integer selProdukte = "" For i = 0 To Me.chkLBProdukte.CheckedItems.Count - 1 For Each r As DataRow In clslc.Produkte.Rows If r("bezeichnung") = Me.chkLBProdukte.CheckedItems(i) Then If selProdukte <> "" Then selProdukte = selProdukte + "," selProdukte = selProdukte + r("ID").ToString End If Next Next Me.C1Result.DataSource = Nothing If Me.txtvon1.Text = " . ." Then selDatumvon = "" Else selDatumvon = Me.txtvon1.Text If Me.txtbis1.Text = " . ." Then selDatumbis = "" Else selDatumbis = Me.txtbis1.Text Get_Reportdata(6) Me.C1Result.DataSource = Reportdata End Sub Dim Reportdata As DataTable Sub Get_Reportdata(ByVal fnkt As Integer) Try Reportdata = Nothing Catch End Try Reportdata = New DataTable Dim selectcommand As New SqlCommand Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("", connection) selectcommand.CommandText = "sp_lc_reporting" selectcommand.Parameters.Add("@fnkt", SqlDbType.Int, 4) selectcommand.Parameters.Add("@param1", SqlDbType.VarChar, 4096) selectcommand.Parameters.Add("@param2", SqlDbType.VarChar, 4096) selectcommand.Parameters.Add("@param3", SqlDbType.VarChar, 4096) selectcommand.Parameters.Add("@param4", SqlDbType.VarChar, 4096) selectcommand.Parameters.Add("@param5", SqlDbType.VarChar, 4096) selectcommand.Parameters.Add("@param6", SqlDbType.VarChar, 4096) selectcommand.Parameters(0).Value = fnkt selectcommand.Parameters(1).Value = "" selectcommand.Parameters(2).Value = "" selectcommand.Parameters(3).Value = "" selectcommand.Parameters(4).Value = "" selectcommand.Parameters(5).Value = "" selectcommand.Parameters(6).Value = "" Select Case fnkt Case 1, 3 Case 2 selectcommand.Parameters(1).Value = Me.cbboxUeberpruefungInTagen.Text.ToString Case 4 selectcommand.Parameters(1).Value = Me.cbboxEntscheidungInTagen.Text.ToString Case 5 selectcommand.Parameters(1).Value = Me.selProdukte selectcommand.Parameters(2).Value = Me.selDatumvon selectcommand.Parameters(3).Value = Me.selDatumbis selectcommand.Parameters(4).Value = Me.cbboxProdukttyp.SelectedValue Case 6 selectcommand.Parameters(1).Value = Me.selProdukte selectcommand.Parameters(2).Value = Me.selDatumvon selectcommand.Parameters(3).Value = Me.selDatumbis selectcommand.Parameters(4).Value = Me.cbboxProdukttyp.SelectedValue Case 7 selectcommand.Parameters(1).Value = Me.selProdukte selectcommand.Parameters(2).Value = Me.cbboxProdukteInTagen.Text.ToString selectcommand.Parameters(3).Value = "" selectcommand.Parameters(4).Value = Me.cbboxProdukttyp.SelectedValue End Select selectcommand.CommandType = CommandType.StoredProcedure selectcommand.Connection = connection Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.SelectCommand = selectcommand da.Fill(Reportdata) Catch ex As Exception MsgBox(ex.Message) Finally connection.Close() da.Dispose() selectcommand.Dispose() End Try End Sub Private Sub C1Result_DoubleClick(sender As Object, e As EventArgs) Handles C1Result.DoubleClick Try Dim f As New frmLifeCycle(Me.C1Result.Columns("Produktnr").Value, True) f.MdiParent = Me.MdiParent f.Show() Catch ex As Exception End Try End Sub Private Sub ListBoxAdv1_ItemClick(sender As Object, e As EventArgs) End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click Dim f As New frmStrukturSelect(TKB.VV.Lifecycle.clslifeCycle.SelectionType.nur_eingesetzt, TKB.VV.Lifecycle.clslifeCycle.SingleMultiSelectionType.MultiSelection) f.CheckedNodes.Clear() For Each s As String In Me.chkLBProdukte.CheckedItems f.CheckedNodes.Add(s) Next f.ImgList = Me.imglist f.ShowDialog() For i As Integer = chkLBProdukte.Items.Count - 1 To 0 Step -1 chkLBProdukte.SetItemCheckState(i, CheckState.Unchecked) Next For i As Integer = f.CheckedNodes.Count - 1 To 0 Step -1 For i1 As Integer = Me.chkLBProdukte.Items.Count - 1 To 0 Step -1 If chkLBProdukte.Items(i1) = f.CheckedNodes(i) Then chkLBProdukte.SetItemCheckState(i1, CheckState.Checked) End If Next Next End Sub Private Sub cbboxProdukttyp1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbboxProdukttyp1.SelectedIndexChanged If Me.OnLoad Then Exit Sub Me.chkLBProdukte.Items.Clear() For Each r As DataRow In clslc.Produkte.Rows If r.Item("Produkttypnr") <> 1 Then ' MsgBox("Hallo") End If If Me.cbboxProdukttyp1.SelectedValue = -1 Or Me.cbboxProdukttyp1.SelectedValue = r("Produkttypnr") Then Me.chkLBProdukte.Items.Add(r("Bezeichnung")) End If Next End Sub Private Sub TSBtnExcelExport_Click(sender As Object, e As EventArgs) Handles TSBtnExcelExport.Click Cursor = Cursors.WaitCursor Dim fn As String = System.IO.Path.GetRandomFileName fn = fn.Substring(0, Len(fn) - 4) fn = Globals.clsapplication.sTmp_filepath.ToString + "\" + fn + "" Dim xls As New XLSLib.clsXLSLib xls.Write_Excel(fn, Reportdata) Dim fnn As String = fn + ".xls" Rename(fn, fnn) Process.Start(fnn) Cursor = Cursors.Default Exit Sub End Sub Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click Me.SaveFileDialog1.AddExtension = True Me.SaveFileDialog1.Filter = "Excel-Dateien|*.xls|CSV-Dateien|*.CSV" Me.SaveFileDialog1.DefaultExt.Insert(0, "*.xls") Me.SaveFileDialog1.ShowDialog() If Me.SaveFileDialog1.FileName <> "" Then If Me.SaveFileDialog1.FileName.EndsWith("xls") Then Me.DatatableToExcel(Reportdata, Me.SaveFileDialog1.FileName) Process.Start(Me.SaveFileDialog1.FileName) Else Me.C1Result.ExportToDelimitedFile(Me.SaveFileDialog1.FileName, C1.Win.C1TrueDBGrid.RowSelectorEnum.AllRows, ";", "", "", True, System.Text.Encoding.Default.BodyName) Process.Start(Me.SaveFileDialog1.FileName) End If End If End Sub 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 Try app.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName) Catch ex As Exception Dim s As String = dr(dc.ColumnName) s = "'" + s Try app.Cells(rowIndex + 1, colIndex) = s Catch ex1 As Exception app.Cells(rowIndex + 1, colIndex) = "'* Text beim Export entfernt" End Try End Try 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 Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click For Each r As DataRow In IDVAuswertungen.Rows If r("Bezeichnung") = cbboxidvauswertungen.Text Then Run_SQL(r("beschreibung")) End If Next End Sub Sub Run_SQL(sqlstring As String) Try Reportdata = Nothing Catch End Try Reportdata = New DataTable Dim Connection As New SqlConnection(Globals.sConnectionString) Dim DA As New SqlDataAdapter(sqlstring, Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) DA.Fill(Reportdata) Me.C1Result.DataSource = Reportdata End Sub Public Sub Get_IDVAuswertungen() Try Me.IDVAuswertungen.Rows.Clear() Dim Connection As New SqlConnection(Globals.sConnectionString) Dim DA As New SqlDataAdapter("select * from lc_sql where aktiv=1 order by bezeichnung", Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) DA.Fill(IDVAuswertungen) Catch End Try End Sub Private Sub C1Result_Click(sender As Object, e As EventArgs) Handles C1Result.Click End Sub End Class