You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

192 lines
7.3 KiB

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