MDM, cDatenserver

VERAG_PROG_ALLGEMEIN/cProgramFunktions.vb

@@ -354,6 +354,91 @@ BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, [Control], New Object(
         End Try
     End Function
 
+    Public Shared Function genExcelFromDT_NEW_(dt As DataTable, Optional rangeAsWaehrung() As String = Nothing, Optional ShowAutoFilter As Boolean = True, Optional HeaderTxt As String = "", Optional HeaderTxt2 As String = "", Optional waehrungsZeichen As String = "€", Optional fitCellsToContent As Boolean = False, Optional mergeHeadersToCell As Char = "", Optional Landscape As Boolean = False, Optional fitToOnePage As Boolean = False, Optional openFile As Boolean = True) As String
+        Try
+
+            Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SDL\tmp\" ' My.Computer.FileSystem.GetTempFileName
+            If Not My.Computer.FileSystem.DirectoryExists(sPath) Then
+                My.Computer.FileSystem.CreateDirectory(sPath)
+            End If
+
+            Dim wb As New XLWorkbook
+            ' Dim dt As DataTable = (dgv.DataSource)
+            ' Dim dt As DataTable = TryCast(dgv., DataTable)
+
+            wb.Worksheets.Add(dt, "DATEN")
+            wb.Worksheets(0).Tables.FirstOrDefault().ShowAutoFilter = ShowAutoFilter
+
+            If rangeAsWaehrung IsNot Nothing Then
+                For Each r In rangeAsWaehrung
+                    Try
+                        wb.Worksheets(0).Range(r).Style.NumberFormat.SetFormat("###,###,##0.00 " & waehrungsZeichen)
+                    Catch ex As Exception
+                        MsgBox(ex.Message & ex.StackTrace)
+                    End Try
+                Next
+            End If
+
+            If HeaderTxt <> "" Then
+                wb.Worksheets(0).FirstRow.InsertRowsAbove(2)
+                wb.Worksheets(0).Range("A1").Value = HeaderTxt
+                wb.Worksheets(0).Range("A1").Style.Font.Bold = True
+
+                If mergeHeadersToCell <> "" Then
+                    wb.Worksheets(0).Range("A1:" & mergeHeadersToCell & "1").Merge()
+                    wb.Worksheets(0).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.Horizontal = XLAlignmentHorizontalValues.Center
+                    wb.Worksheets(0).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.Vertical = XLAlignmentVerticalValues.Center
+                    wb.Worksheets(0).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.WrapText = True
+                End If
+
+                If HeaderTxt2 <> "" Then
+                    wb.Worksheets(0).Range("A2").Value = HeaderTxt2
+                    wb.Worksheets(0).Row(2).InsertRowsBelow(1)
+
+                    If mergeHeadersToCell <> "" Then
+                        wb.Worksheets(0).Range("A2:" & mergeHeadersToCell & "2").Merge()
+                        wb.Worksheets(0).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.Horizontal = XLAlignmentHorizontalValues.Center
+                        wb.Worksheets(0).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.Vertical = XLAlignmentVerticalValues.Center
+                        wb.Worksheets(0).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.WrapText = True
+                    End If
+
+                End If
+
+            End If
+
+            If fitCellsToContent Then
+                wb.Worksheets(0).Columns().AdjustToContents()
+                wb.Worksheets(0).Rows().AdjustToContents()
+            End If
+
+            If Landscape Then
+                wb.Worksheets(0).PageSetup.PageOrientation = XLPageOrientation.Landscape
+            Else
+                wb.Worksheets(0).PageSetup.PageOrientation = XLPageOrientation.Default
+            End If
+
+            If fitToOnePage Then
+
+                wb.Worksheets(0).PageSetup.PagesWide = 1  ' In die Breite auf eine Seite anpassen
+                wb.Worksheets(0).PageSetup.PagesTall = 1 ' In die Höhe auf eine Seite anpassen
+
+
+            End If
+
+
+            Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx"
+            wb.SaveAs(filename)
+
+
+            If openFile Then Process.Start(filename)
+
+            Return filename
+        Catch ex As Exception
+            MsgBox(ex.Message & ex.StackTrace)
+            Return Nothing
+        End Try
+    End Function
+
     Public Shared Function sendMail(eMailTo, betreff, text, Optional eMailfrom = "support@verag.ag", Optional prio = False, Optional uhrzeitAngeben = True, Optional cc = "", Optional bcc = "", Optional anhaenge = Nothing, Optional art = 0)
         Dim Msg As New MailMessage
         Dim myCredentials As New System.Net.NetworkCredential