Imports System.Data.SqlClient Imports System.Data.SqlTypes Public Class frmUMVDokumente Dim dt As New DataTable 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 'close button Me.Close() Case 1 'Excel-Export 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.dt, Me.SaveFileDialog1.FileName) End If End If End Select End Sub Private Function Get_Data() As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "dbo.SP_get_unvollst_uvmdokumente" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn.scoDBConnection sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() dtToReturn.Dispose() End Try End Function Private Sub frmUMVDokumente_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Application.DoEvents() End Sub Public Sub Load_Data() Cursor = Cursors.WaitCursor dt = Get_Data() Me.DomainList.DataSource = dt Me.DomainList.DataMember = dt.TableName Me.DomainList.AllowUpdate = False Me.DomainList.AllowDelete = False Me.DomainList.AllowAddNew = False Dim ds As New DataSet ds.Tables.Add(dt) Me.SpaltenTitel_Aktualisieren(ds) Cursor = Cursors.Default End Sub Public Sub SpaltenTitel_Aktualisieren(ByVal ds As DataSet) 'Spaltentitel setzen Dim titel As New EDOKA.MySpaltenTitel() Dim anzcols As Integer Dim cols(Me.DomainList.Splits(0).DisplayColumns.Count) As C1.Win.C1TrueDBGrid.C1DisplayColumn Dim ts As New EDOKA.Tabellenspalte() Dim i As Integer Dim t As New DataTable() Dim dc As C1.Win.C1TrueDBGrid.C1DisplayColumn Dim s As String anzcols = Me.DomainList.Splits(0).DisplayColumns.Count t = ds.Tables(0) ts.Tabelle = "UeberfaelligeDokumente" For i = 0 To Me.DomainList.Columns.Count - 1 s = Me.DomainList.Columns(i).DataField ts.Feld = s ts.getspalte() Me.DomainList.Columns(i).Caption = ts.spaltenname If ts.ColWith = 0 Then Me.DomainList.Splits(0).DisplayColumns(i).Width = 0 Me.DomainList.Splits(0).DisplayColumns(i).Visible = False Else Me.DomainList.Splits(0).DisplayColumns(i).Width = ts.ColWith End If If ts.locked Then Me.DomainList.Splits(0).DisplayColumns(i).Locked = True End If If ts.AlsHacken Then Me.DomainList.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox End If 'Präsentation von aktiv If Me.DomainList.Columns(i).DataField = "aktiv" Then Me.DomainList.Columns(i).ValueItems.Presentation = C1.Win.C1TrueDBGrid.PresentationEnum.CheckBox Me.DomainList.Columns(i).ValueItems.DefaultItem = True Me.DomainList.Columns(i).DefaultValue = True Me.DomainList.Columns(i).FilterText = True End If If Me.DomainList.Columns(i).DataField = "erstellt_am" Then Me.DomainList.Columns(i).DefaultValue = Now End If Next End Sub Private Sub PartnerdossierAnzeigenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PartnerdossierAnzeigenToolStripMenuItem.Click Dim f As New frmTrefferliste() f.MdiParent = Me.MdiParent f.Show() f.txtnrpar00.Text = Me.DomainList.Columns("partnernr").Value.ToString f.Partnernr = Me.DomainList.Columns("partnernr").Value.ToString f.Partner_Eingegeben = True f.refresh_list() f.Refresh_All(True) f.PosDok(Me.DomainList.Columns("Dokumentid").Value.ToString, Me.DomainList.Columns("Dokumentartnr").Value.ToString) Me.Cursor = System.Windows.Forms.Cursors.Default End Sub Private Sub DomainList_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles DomainList.MouseDown Me.DomainList.Bookmark = Me.DomainList.RowContaining(e.Y) 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 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 Class