fakt, etc.

This commit is contained in:
2025-10-30 12:00:22 +01:00
parent a1889578d8
commit 52e0041754
19 changed files with 1921 additions and 543 deletions

View File

@@ -1192,6 +1192,89 @@ Public Class cProgramFunctions
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 genExcelFromMultibleDT_NEW(datatables As IEnumerable(Of 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, Optional fitWideToOnePage As Boolean = False) 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 counter = 0
For Each dt In datatables
wb.Worksheets.Add(dt, "DATEN" & IIf(counter > 0, "_" & counter, ""))
wb.Worksheets(counter).Tables.FirstOrDefault().ShowAutoFilter = ShowAutoFilter
If rangeAsWaehrung IsNot Nothing Then
For Each r In rangeAsWaehrung
Try
wb.Worksheets(counter).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(counter).FirstRow.InsertRowsAbove(2)
wb.Worksheets(counter).Range("A1").Value = HeaderTxt
wb.Worksheets(counter).Range("A1").Style.Font.Bold = True
If mergeHeadersToCell <> "" Then
wb.Worksheets(counter).Range("A1:" & mergeHeadersToCell & "1").Merge()
wb.Worksheets(counter).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.Horizontal = XLAlignmentHorizontalValues.Center
wb.Worksheets(counter).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.Vertical = XLAlignmentVerticalValues.Center
wb.Worksheets(counter).Range("A1:" & mergeHeadersToCell & "1").Style.Alignment.WrapText = True
End If
If HeaderTxt2 <> "" Then
wb.Worksheets(counter).Range("A2").Value = HeaderTxt2
wb.Worksheets(counter).Row(2).InsertRowsBelow(1)
If mergeHeadersToCell <> "" Then
wb.Worksheets(counter).Range("A2:" & mergeHeadersToCell & "2").Merge()
wb.Worksheets(counter).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.Horizontal = XLAlignmentHorizontalValues.Center
wb.Worksheets(counter).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.Vertical = XLAlignmentVerticalValues.Center
wb.Worksheets(counter).Range("A2:" & mergeHeadersToCell & "2").Style.Alignment.WrapText = True
End If
End If
End If
If fitCellsToContent Then
wb.Worksheets(counter).Columns().AdjustToContents()
wb.Worksheets(counter).Rows().AdjustToContents()
End If
If Landscape Then
wb.Worksheets(counter).PageSetup.PageOrientation = XLPageOrientation.Landscape
Else
wb.Worksheets(counter).PageSetup.PageOrientation = XLPageOrientation.Default
End If
If fitToOnePage Then wb.Worksheets(counter).PageSetup.PagesWide = 1 : wb.Worksheets(counter).PageSetup.PagesTall = 1 ' In die Höhe/Breite auf eine Seite anpassen
If fitWideToOnePage Then wb.Worksheets(counter).PageSetup.PagesWide = 1
counter += 1
Next
Dim filename As String = sPath & "tmp_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx"
wb.SaveAs(filename)