Imports System.Globalization Imports Microsoft.Office.Interop Imports Microsoft.Office.Interop.Outlook Public Class usrctlBuergschaft Dim month As String = Now().Month Dim year As String = Now().Year Dim stift As New Pen(Color.Gray, 1) ' Dim stift2 As New Pen(Color.LightGray, 2) ' Dim left As Integer = 200 ' Dim top As Integer = 50 Dim f_black As New Font("Arial", 8) Dim f_black_bold As New Font("Arial", 8, FontStyle.Bold) ' Dim f_red As New Font("Arial", 8) Dim greyBrush As New SolidBrush(System.Drawing.Color.FromArgb(240, 240, 240)) Dim dayOWeek As Array = {"So", "Mo", "Di", "Mi", "Do", "Fr", "Sa"} Dim monthOYear As Array = {"Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember"} Private l As New List(Of Rectangle) Private d As New List(Of DateTime) Dim isDrawn As Boolean = False Dim BRG As New cBrgDb Dim buergschaften As New List(Of cBuergschaft) Dim cProgramFunctions As New cProgramFunctions Public brg_AT As String = "05AT510000G000FP7" Public brg_DE As String = "05DE0000000009345" Public brg_DE_NEU As String = "17DE0000000071678" Private Sub frmDienstplan_Load(sender As Object, e As EventArgs) Handles Me.Load buergschaften = BRG.getBrg(Now()) cboTage.SelectedIndex = 0 reset() For i = 1 To 53 cboAtillaDurmazKw.Items.Add(i) Next ComboBox2.Items.Clear() ComboBox1.Items.Clear() cboAtillaDurmazYear.Items.Clear() For i = 2012 To Now.Year ComboBox2.Items.Add(i) ComboBox1.Items.Add(i) cboAtillaDurmazYear.Items.Add(i) Next cboAtillaDurmazKw.Text = cProgramFunctions.getKW(Now.AddDays(-7)) cboAtillaDurmazYear.Text = Now.AddDays(-7).Year cboSystemAuswertungJahrWo.SelectedIndex = 0 End Sub Private Sub pnlKalender_Click(ByVal sender As Object, ByVal e As MouseEventArgs) Handles pnlKalender.MouseDoubleClick For i As Integer = 0 To l.Count - 1 If l(i).Contains(e.Location) Then 'MsgBox(d(i)) frmBrgDetails.datum = d(i) frmBrgDetails.Show() AddHandler frmBrgDetails.FormClosed, AddressOf initPaint End If Next End Sub Private Sub pnlKalender_Paint(sender As Object, e As PaintEventArgs) Handles pnlKalender.Paint ' paintFirstLine(e) l = New List(Of Rectangle) d = New List(Of DateTime) paintLineWeek(e) lblMonat.Text = monthOYear(month - 1) End Sub ' Private Sub paintFirstLine(e As PaintEventArgs) 'Dim pint_x As Integer = 20 ' Dim pint_y As Integer = 20 'isDrawn = True 'Dim z As Graphics 'z = e.Graphics 'Dim myDT As DateTime = DateTime.Now 'Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar 'Dim dayOWeek As Array = {"Mo", "Di", "Mi", "Do", "Fr", "Sa", "So"} 'Dim left As Integer = 0 'For Each o As String In dayOWeek 'z.DrawRectangle(stift, left + pint_x, pint_y, 100, 30) 'Rahmen lastMonth 'z.DrawString(o, f_black_bold, Brushes.Black, left + +pint_x + 10, pint_y + 10) 'left += 100 'Next 'End Sub Private Sub paintLineWeek(e As PaintEventArgs) Dim pint_x As Integer = 10 Dim pint_y As Integer = 60 Dim top As Integer = 0 Dim cell_with As Integer = 130 Dim cell_height As Integer = 100 ' If Not isDrawn Then isDrawn = True Dim z As Graphics z = e.Graphics Dim myDT As DateTime = DateTime.Now myDT = "01." & month & "." & year Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar Dim left As Integer = 0 Dim b As Brush = Brushes.Black While True ' MsgBox(myDT) Dim ddd As DateTime = myCal.GetDaysInMonth(myDT.Year, myDT.Month) & "." & month & "." & year For i As Integer = 1 To 7 Dim day As String = myCal.GetDayOfWeek(myDT) If day = i Or day = i - 7 Then If day = 0 Then b = Brushes.Red z.FillRectangle(greyBrush, left + pint_x, top + pint_y, cell_with, cell_height) Else : b = Brushes.Black End If z.DrawRectangle(stift, left + pint_x, top + pint_y, cell_with, cell_height) 'Rahmen lastMonth 'rectangle für späteres Mouseklick-Event: Dim r As New Rectangle(left + pint_x, top + pint_y, cell_with, cell_height) l.Add(r) d.Add(myDT) 'Tag und Datum in Zelle schreiben: z.DrawString(dayOWeek(day) & ", " & myDT.ToString("dd.MM.yyyy"), f_black_bold, b, left + pint_x + 5, top + pint_y + 5) 'Tagessaldo AT: z.DrawString(getSaldo("d", "AT", myDT), f_black, b, left + pint_x + 5, top + pint_y + 25) 'Wochenreferenz AT: z.DrawString(getSaldo("w", "AT", myDT), f_black, b, left + pint_x + 5, top + pint_y + 40) 'Tagessaldo DE: z.DrawString(getSaldo("d", "DE", myDT), f_black, b, left + pint_x + 5, top + pint_y + 60) 'Wochenreferenz DE: z.DrawString(getSaldo("w", "DE", myDT), f_black, b, left + pint_x + 5, top + pint_y + 75) 'Zähler-Datum um eins erhöhen: myDT = myCal.AddDays(myDT, 1) End If '& myCal.GetEra(myDT) left += cell_with If myDT > ddd Then Exit While End If Next left = 0 top += cell_height End While End Sub Function getSaldo(ByVal dayweek As String, ByVal buergschaft As String, ByVal datum As DateTime) As String For Each b In buergschaften If b.brg_datum = datum Then If dayweek = "d" Then If buergschaft = "AT" And b.brg_at_tag <> "" Then Return "Tg.AT: " & String.Format("{0:C}", CDbl(b.brg_at_tag)) If buergschaft = "DE" And b.brg_at_woche <> "" Then Return "Wo.AT: " & String.Format("{0:C}", CDbl(b.brg_at_woche)) End If If dayweek = "w" Then If buergschaft = "AT" And b.brg_de_tag <> "" Then Return "Tg.DE: " & String.Format("{0:C}", CDbl(b.brg_de_tag)) If buergschaft = "DE" And b.brg_de_woche <> "" Then Return "Wo.DE: " & String.Format("{0:C}", CDbl(b.brg_de_woche)) End If End If Next Return "" End Function Private Sub Painttest(e As PaintEventArgs) ' If Not isDrawn Then isDrawn = True Dim z As Graphics z = e.Graphics Dim stift As New Pen(Color.Gray, 1) Dim stift2 As New Pen(Color.LightGray, 2) Dim left As Integer = 200 Dim top As Integer = 50 Dim f_black As New Font("Arial", 8) Dim f_black_bold As New Font("Arial", 8, FontStyle.Bold) ' Dim f_red As New Font("Arial", 8) Dim myDT As DateTime = DateTime.Now Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar Dim lastMonth As DateTime = myCal.AddMonths(myDT, -1) Dim nextMonth As DateTime = myCal.AddMonths(myDT, 1) z.DrawString(" Era: " & myCal.GetEra(myDT), f_black, Brushes.Black, 0, 0) z.DrawString(" Year: " & myCal.GetYear(myDT), f_black, Brushes.Black, 0, 20) z.DrawString(" Month: " & myCal.GetMonth(myDT), f_black, Brushes.Black, 0, 40) z.DrawString(" DayOfYear: " & myCal.GetDayOfYear(myDT), f_black, Brushes.Black, 0, 60) z.DrawString(" DayOfMonth: " & myCal.GetDayOfMonth(myDT), f_black, Brushes.Black, 0, 80) z.DrawString(" DayOfWeek: " & myCal.GetDayOfWeek(myDT), f_black, Brushes.Black, 0, 100) z.DrawString(" Hour: " & myCal.GetHour(myDT), f_black, Brushes.Black, 0, 120) z.DrawString(" Minute: " & myCal.GetMinute(myDT), f_black, Brushes.Black, 0, 140) z.DrawString(" Second: " & myCal.GetSecond(myDT), f_black, Brushes.Black, 0, 160) z.DrawString(" Milliseconds: " & myCal.GetMilliseconds(myDT), f_black, Brushes.Black, 0, 180) ' Dim lastMonth As DateTime = myCal.AddMonths(myDT, -1) z.DrawString(" lastMonth: " & myCal.GetMonth(lastMonth), f_black, Brushes.Black, 0, 200) z.DrawString(" nextMonth: " & myCal.GetMonth(nextMonth), f_black, Brushes.Black, 0, 220) Dim daysLastM As Integer = myCal.GetDaysInMonth(myCal.GetYear(lastMonth), myCal.GetMonth(lastMonth)) Dim daysThisM As Integer = myCal.GetDaysInMonth(myCal.GetYear(myDT), myCal.GetMonth(myDT)) Dim daysNextM As Integer = myCal.GetDaysInMonth(myCal.GetYear(nextMonth), myCal.GetMonth(nextMonth)) Dim greyBrush As New SolidBrush(Color.LightGray) z.FillRectangle(greyBrush, left, top - 50, (daysLastM + daysThisM + daysNextM) * 20, 20) z.DrawRectangle(stift, left, top - 50, daysLastM * 20, 20) 'Rahmen lastMonth z.DrawRectangle(stift, left, top - 50, (daysLastM + daysThisM) * 20, 20) 'Rahmen myCal z.DrawRectangle(stift, left, top - 50, (daysLastM + daysThisM + daysNextM) * 20, 20) 'Rahmen nextMonth z.DrawString(monthOYear(myCal.GetMonth(lastMonth) - 1), f_black, Brushes.Black, left + daysLastM * 20 / 2, 2) z.DrawString(monthOYear(myCal.GetMonth(myDT) - 1), f_black_bold, Brushes.Black, left + daysLastM * 20 + daysThisM * 20 / 2, 2) z.DrawString(monthOYear(myCal.GetMonth(nextMonth) - 1), f_black, Brushes.Black, left + daysLastM * 20 + daysThisM * 20 + daysNextM * 20 / 2, 2) z.DrawRectangle(stift, 0, 0, 1800 + left, 500 + top) 'Rahmen Dim blueBrush As New SolidBrush(Color.LightBlue) Dim greenBrush As New SolidBrush(Color.LightGreen) z.FillRectangle(blueBrush, left, top - 30, 90 * 20, 30) Dim arrayDays(daysLastM + daysThisM + daysNextM) As Date Dim cnt As Integer = 0 'lastMonth zeichnen: For i As Integer = 0 To daysLastM - 1 z.DrawRectangle(stift, left + i * 20, top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(lastMonth), myCal.GetMonth(lastMonth), i + 1) Dim dow As String = dayOWeek(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black z.DrawString(dow & vbNewLine & (i + 1), f_black, b, left + i * 20, top - 30) arrayDays(cnt) = d : cnt += 1 Next 'thisMonth zeichnen: For i As Integer = 0 To daysThisM - 1 z.DrawRectangle(stift, left + i * 20, top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(myDT), myCal.GetMonth(myDT), i + 1) Dim dow As String = dayOWeek(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black Dim f As Font = f_black : If (i + 1) = myCal.GetDayOfMonth(myDT) Then f = f_black_bold z.DrawString(dow & vbNewLine & (i + 1), f, b, left + (daysLastM + i) * 20, top - 30) arrayDays(cnt) = d : cnt += 1 Next 'nextMonth zeichnen: For i As Integer = 0 To daysNextM - 1 z.DrawRectangle(stift, left + i * 20, top - 30, 20, 30) Dim b As Brush : Dim d As New DateTime(myCal.GetYear(nextMonth), myCal.GetMonth(nextMonth), i + 1) Dim dow As String = dayOWeek(myCal.GetDayOfWeek(d)) If dow = "Sa" Or dow = "So" Then b = Brushes.Red Else b = Brushes.Black z.DrawString(dow & vbNewLine & (i + 1), f_black, b, left + (daysLastM + daysThisM + i) * 20, top - 30) arrayDays(cnt) = d : cnt += 1 Next For j As Integer = 0 To 20 For i As Integer = 0 To 90 z.DrawRectangle(stift, left + i * 20, top + j * 20, 20, 20) Next Next Dim startDate As New DateTime(2015, 2, 15) Dim endDate As New DateTime(2015, 2, 18) Dim x_start As Integer : Dim x_end As Integer If arrayDays(arrayDays.Count - 1) < endDate Then x_start = arrayDays.Count * 20 + 20 If arrayDays(0) > startDate Then x_start = 0 Dim diff As Integer For i As Integer = 0 To arrayDays.Count - 1 If arrayDays(i) = startDate Then x_start = i * 20 : diff = i If arrayDays(i) = endDate Then x_end = (i - diff) * 20 + 20 Next z.FillRectangle(greenBrush, left + x_start, top, x_end, 20) 'End If End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim myDT As DateTime = DateTime.Now myDT = "01." & month & "." & year Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar myDT = myCal.AddMonths(myDT, -1) month = myDT.Month year = myDT.Year Dim d As DateTime = "01." & month & "." & year buergschaften = BRG.getBrg(d) pnlKalender.Invalidate() End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim myDT As DateTime = DateTime.Now myDT = "01." & month & "." & year Dim myCal As Calendar = CultureInfo.InvariantCulture.Calendar myDT = myCal.AddMonths(myDT, 1) month = myDT.Month year = myDT.Year Dim d As DateTime = "01." & month & "." & year buergschaften = BRG.getBrg(d) pnlKalender.Invalidate() End Sub Private Sub initPaint() Dim d As DateTime = "01." & month & "." & year buergschaften = BRG.getBrg(d) pnlKalender.Invalidate() frmMain.BringToFront() End Sub Private Sub btnExcel_Click(sender As Object, e As EventArgs) Handles btnExcel.Click GroupBox1.Cursor = Cursors.WaitCursor Dim Visible As Boolean = Not email Dim tage As Integer = 7 If cboTage.SelectedIndex = 0 Then tage = 7 If cboTage.SelectedIndex = 1 Then tage = 8 Dim startdate As Date = Now startdate = datAuswertungStartdatum.Value Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If Dim r = cProgramFunctions.genEXCEL_Auswertungen(sPath, tage, startdate, cbxATAustellung.Checked, cbxGesamt.Checked, True) If r.StartsWith("ERR") Then MsgBox(r) End If GroupBox1.Cursor = Cursors.Default End Sub ' Private Sub btnExcel_Clickold(sender As Object, e As EventArgs) ' Handles btnExcel.Click 'Dim BRG As New cBrgDb ' Dim monday As Date = CalendarWeek(cboKW.SelectedIndex + 1, cboJahr.Text) ' Dim sunday As Date = monday.AddDays(6) ' Dim buergschaften As List(Of cBuergschaft) = BRG.getBrgVonBis(monday.ToShortDateString, sunday.ToShortDateString) ' Dim exclApp As Object 'as Application ' Dim Datei As Object 'as WorkBook ' Dim Blatt As Object 'as WorkSheet ' exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) 'With exclApp '.Visible = True ' Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName ' If Not My.Computer.FileSystem.DirectoryExists(sPath) Then ' My.Computer.FileSystem.CreateDirectory(sPath) 'End If ' 'Try ' My.Computer.FileSystem.WriteAllBytes(sPath & "Auswertung.xlsx", My.Resources.Bürgschaften_Vorlage, False) 'Catch ex As Exception ' MsgBox(ex.Message) 'Exit Sub 'End Try ' ' 'Datei = .Workbooks.Open(sPath & "Auswertung.xlsx") 'Anpassen 'Blatt = Datei.Worksheets("Auswertung") 'Anpassen ''Blatt.Range("A1").Value = TextBox1.Text ' 'Blatt.Range("A4").Value = cboKW.Text 'Blatt.Range("A13").Value = "Gesamt " & cboKW.Text & ":" 'Dim aktdate As Date = monday ''Dim cnt As Integer = 6 'For i As Integer = 6 To 12 ' Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") '' MsgBox(aktdate.ToLongTimeString) 'For Each b In buergschaften ' If b.brg_datum = aktdate.ToShortDateString Then ' Blatt.Range("B" & i).Value = toDec(b.brg_at_woche) ': MsgBox(b.brg_at_woche) 'Blatt.Range("D" & i).Value = toDec(b.brg_at_tag) ': MsgBox(b.brg_at_tag) 'Blatt.Range("F" & i).Value = toDec(b.brg_de_woche) ': MsgBox(b.brg_de_woche) 'Blatt.Range("H" & i).Value = toDec(b.brg_de_tag) ': MsgBox(b.brg_de_tag) 'Exit For 'End If 'Next ' 'aktdate = aktdate.AddDays(1) 'Next ' 'If cbxATAustellung.Checked Then ' Blatt.Range("A18").Value = "Bürgschaft AT:" '''Blatt.Range("B19").Value = "ATLAS" 'aktdate = monday 'For i As Integer = 20 To 26 ' Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") '' MsgBox(aktdate.ToLongTimeString) 'For Each b In buergschaften ' If b.brg_datum = aktdate.ToShortDateString Then ' Blatt.Range("B" & i).Value = toDec(b.brg_at_woche_atlas) ': MsgBox(b.brg_at_woche) 'Exit For 'vEnd If 'Next ' 'aktdate = aktdate.AddDays(1) 'Next 'aktdate = monday 'Blatt.Range("B28").Value = "ZOLARIS" 'For i As Integer = 29 To 35 ' Blatt.Range("A" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") '' MsgBox(aktdate.ToLongTimeString) 'For Each b In buergschaften ' If b.brg_datum = aktdate.ToShortDateString Then ' Blatt.Range("B" & i).Value = toDec(b.brg_at_woche_zolaris) ': MsgBox(b.brg_at_woche) 'vExit For 'End If 'Next ' 'aktdate = aktdate.AddDays(1) 'Next 'End If ' 'If cbxGesamt.Checked Then ' Dim sum As Decimal = 0 'Blatt.Range("H18").Value = "GESAMT" 'Blatt.Range("F26").Value = "Gesamt-Summe:" 'aktdate = monday 'For i As Integer = 19 To 25 ' Blatt.Range("F" & i).Value = aktdate.ToString("ddd, dd.MM.yyyy") '' MsgBox(aktdate.ToLongTimeString) 'For Each b In buergschaften ' If b.brg_datum = aktdate.ToShortDateString Then 'v Blatt.Range("H" & i).Value = decSum(b.brg_at_woche, b.brg_de_woche) ': MsgBox(b.brg_at_woche) ''sum += decSum(b.brg_at_woche, b.brg_de_woche) 'Exit For 'End If 'Next 'Blatt.Range("H26").Value = sum 'aktdate = aktdate.AddDays(1) 'Next ' 'End If ''Datei.close(True) ''.quit() 'End With ' ' 'End Sub Private Function decSum(ByVal s1 As String, ByVal s2 As String, Optional s3 As String = "0") As Decimal Dim d1 As Decimal = 0 Dim d2 As Decimal = 0 Dim d3 As Decimal = 0 Try d1 = CDec(s1) Catch ex As System.Exception : End Try Try d2 = CDec(s2) Catch ex As System.Exception : End Try Try d3 = CDec(s3) Catch ex As System.Exception : End Try Return (d1 + d2 + d3) End Function Public Function DateToWeek(ByVal dDate As Date) As String ' Startdatum der ersten Kalenderwoche des Jahres und Folgejahres berechnen Dim dThisYear As Date = CalendarWeek(1, dDate.Year) Dim dNextYear As Date = CalendarWeek(1, dDate.Year + 1) ' Prüfen, ob Datum zur ersten Woche des Folgejahres gehört If dDate >= dNextYear Then ' Rückgabe: KW 1 des Folgejahres Return "01" ElseIf dDate < dThisYear Then ' Falls das Datum noch zu einer KW aus dem letzten Jahr zählt Return DatePart(DateInterval.WeekOfYear, _ New Date(dDate.Year - 1, 12, 28), FirstDayOfWeek.Monday, _ FirstWeekOfYear.FirstFourDays) Else ' KW = Differenz zum ersten Tag der ersten Woche Return Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00") End If End Function Public Function CalendarWeek(ByVal nWeek As Integer, ByVal nYear As Integer) As Date ' Wochentag des 4. Januar des Jahres ermitteln Dim dStart As New Date(nYear, 1, 4) Dim nDay As Integer = (dStart.DayOfWeek + 6) Mod 7 + 1 ' Beginn der 1. KW des Jahres Dim dFirst As Date = dStart.AddDays(1 - nDay) ' Gesuchte KW ermitteln Return dFirst.AddDays((nWeek - 1) * 7) End Function Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click Me.Cursor = Cursors.WaitCursor cProgramFunctions.EINLESEN(datEinlesenVon.Value, datEinlesenBis.Value) Me.Cursor = Cursors.Default End Sub Private Function StrIntValue(ByVal d As Decimal) As String If d = 0 Then Return "" Else : Return d.ToString End If End Function Private Function toDec(ByVal s As Object) As Decimal Try If s = "" Then Return 0 Return CDec(s) Catch ex As System.Exception Return 0 End Try End Function Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click Me.Cursor = Cursors.WaitCursor Try ' BRG.getBrgFromFMZOLL(datEinlesenVon.Value.ToShortDateString, datEinlesenBis.Value.ToShortDateString, "50", "60","05AT510000G000FP7") ' BRG.getBrgSumFromFMZOLL_Zolaris(datEinlesenVon.Value.ToShortDateString, "50", "60", "05AT510000G000FP7") 'HIER 'Dim aktdat As Date = datEinlesenVon.Value Dim cBrgYear As New List(Of cBrgYear) Dim year As Integer = ComboBox1.Text For kw As Integer = 1 To 53 Dim aktdat As Date = CalendarWeek(kw, year) Dim b As New cBrgYear b.kw = kw b.at__atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT)) b.de_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE)) b.de2_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE_NEU)) b.at_zolaris = toDbl(BRG.getBrgSumFromFMZOLL_Zolaris(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT)) 'MsgBox("AT: " & decSum(b.at__atlas, b.at_zolaris) & " DE: " & b.de_atlas) cBrgYear.Add(b) Next genExcelYear(cBrgYear, year) Catch ex As System.Exception MsgBox("Problem beim Verarbeiten der Jahresauswertung!" & vbNewLine & ex.Message) End Try Me.Cursor = Cursors.Default End Sub Private Sub genExcelYear(ByVal cBrgYear As List(Of cBrgYear), ByVal year As String, Optional estr As String = "") Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Object 'as WorkSheet exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) With exclApp .Visible = True Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If Try My.Computer.FileSystem.WriteAllBytes(sPath & "Jahresauswertung_" & year & ".xlsx", My.Resources.Buergschaften_Jahresauswertung, False) Catch ex As System.Exception MsgBox(ex.Message) Exit Sub End Try Datei = .Workbooks.Open(sPath & "Jahresauswertung_" & year & ".xlsx") 'Anpassen Blatt = Datei.Worksheets("Tabelle1") 'Anpassen 'Blatt.Range("A1").Value = TextBox1.Text ' Blatt.Range("A4").Value = tage & " Tage" ' Blatt.Range("A14").Value = "Gesamt " & tage & " Tage:" ' Dim today As Date = Now 'Dim aktdate As Date = today.AddDays(-6) 'Dim cnt As Integer = 6 Blatt.Range("D1").Value = year If estr <> "" Then Blatt.Range("A2").Value = estr For Each b In cBrgYear ' MsgBox(b.at__atlas & " - " & b.at_zolaris & " - " & b.de_atlas) Blatt.Range("B" & (3 + b.kw)).Value = decSum(toDbl(b.at__atlas), toDbl(b.at_zolaris)) Blatt.Range("C" & (3 + b.kw)).Value = toDbl(b.de_atlas) Blatt.Range("D" & (3 + b.kw)).Value = toDbl(b.de2_atlas) Blatt.Range("E" & (3 + b.kw)).Value = decSum(decSum(toDbl(b.at__atlas), toDbl(b.at_zolaris)), toDbl(b.de_atlas), toDbl(b.de2_atlas)) Next 'Datei.close(True) '.quit() End With End Sub Private Sub genExcelYearSplitATLASEZOLL(ByVal cBrgYear As List(Of cBrgYear), ByVal year As String, Optional estr As String = "") Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Object 'as WorkSheet exclApp = CreateObject("Excel.Application") ' Dim nWeek As Integer ' nWeek = DatePart(DateInterval.WeekOfYear, New Date(2004, 3, 22), _ ' FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFourDays) With exclApp .Visible = True Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If Try My.Computer.FileSystem.WriteAllBytes(sPath & "Jahresauswertung_" & year & ".xlsx", My.Resources.Buergschaften_JahresauswertungSplit, False) Catch ex As System.Exception MsgBox(ex.Message) Exit Sub End Try Datei = .Workbooks.Open(sPath & "Jahresauswertung_" & year & ".xlsx") 'Anpassen Blatt = Datei.Worksheets("Tabelle1") 'Anpassen 'Blatt.Range("A1").Value = TextBox1.Text ' Blatt.Range("A4").Value = tage & " Tage" ' Blatt.Range("A14").Value = "Gesamt " & tage & " Tage:" ' Dim today As Date = Now 'Dim aktdate As Date = today.AddDays(-6) 'Dim cnt As Integer = 6 Blatt.Range("D1").Value = year If estr <> "" Then Blatt.Range("A2").Value = estr For Each b In cBrgYear ' MsgBox(b.at__atlas & " - " & b.at_zolaris & " - " & b.de_atlas) Blatt.Range("B" & (3 + b.kw)).Value = toDbl(b.at__atlas) Blatt.Range("C" & (3 + b.kw)).Value = toDbl(b.at_zolaris) Blatt.Range("D" & (3 + b.kw)).Value = toDbl(b.de_atlas) Blatt.Range("E" & (3 + b.kw)).Value = toDbl(b.de2_atlas) Blatt.Range("F" & (3 + b.kw)).Value = decSum(decSum(toDbl(b.at__atlas), toDbl(b.at_zolaris)), toDbl(b.de_atlas), toDbl(b.de2_atlas)) Next 'Datei.close(True) '.quit() End With End Sub Private Function getcboDataNL(ByVal c As ComboBox) As String If c.SelectedIndex = 0 Then Return "" Else : Return c.Text.Substring(0, 3) End If End Function Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click Me.Cursor = Cursors.WaitCursor Try dgvData.DataSource = BRG.getBrgFromFMZOLL_Zabis(datDataVon.Value.ToShortDateString, datDataBis.Value.ToShortDateString, cboDataStatVon.Text, cboDataStatBis.Text, cboDataBuerg.Text, getcboDataNL(cboDataNL)) initDgvData() Catch ex As System.Exception MsgBox("Problem beim Einlesen!" & vbNewLine & ex.Message) End Try Me.Cursor = Cursors.Default Dim summe As Decimal = 0 For i As Integer = 0 To dgvData.Rows.Count - 1 If dgvData.Rows(i).Cells(22).Value IsNot DBNull.Value Then summe += CDec(dgvData.Rows(i).Cells(22).Value) End If Next lblSum.Text = "Summe: " & String.Format("{0:C}", summe) lblRows.Text = "Zeilen: " & dgvData.Rows.Count End Sub Private Sub initDgvData() With dgvData .AllowUserToAddRows = False .AllowUserToDeleteRows = False .ReadOnly = True .Columns(21).DefaultCellStyle.Format = "N2" .Columns(22).DefaultCellStyle.Format = "N2" .Columns(21).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight .Columns(22).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleRight End With End Sub Private Sub exportToExcel(dgv As DataGridView) Dim counter As Integer = 0 ' Dim tb_count As Integer = 10 Cursor.Current = Cursors.WaitCursor Label3.Visible = True ' lb_pcnt.Visible = True ' lb_pcnt.Text = counter.ToString("p") If ((dgvData.Columns.Count = 0) Or (dgv.Rows.Count = 0)) Then Exit Sub End If Dim dset As New DataSet dset.Tables.Add() For i As Integer = 0 To dgv.ColumnCount - 1 dset.Tables(0).Columns.Add(dgv.Columns(i).HeaderText) Next Dim dr1 As DataRow For i As Integer = 0 To dgv.RowCount - 1 dr1 = dset.Tables(0).NewRow For j As Integer = 0 To dgv.Columns.Count - 1 dr1(j) = dgv.Rows(i).Cells(j).Value Next dset.Tables(0).Rows.Add(dr1) Next Dim excel As New Microsoft.Office.Interop.Excel.Application Dim wBook As Microsoft.Office.Interop.Excel.Workbook Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet wBook = excel.Workbooks.Add() wSheet = wBook.ActiveSheet() Dim dt As System.Data.DataTable = dset.Tables(0) Dim dc As System.Data.DataColumn Dim dr As System.Data.DataRow Dim colIndex As Integer = 0 Dim rowIndex As Integer = 0 For Each dc In dt.Columns colIndex = colIndex + 1 excel.Cells(1, colIndex) = dc.ColumnName Next For Each dr In dt.Rows rowIndex = rowIndex + 1 colIndex = 0 For Each dc In dt.Columns colIndex = colIndex + 1 If colIndex = 22 Or colIndex = 23 Then excel.Cells(rowIndex + 1, colIndex) = toDec(dr(dc.ColumnName)) Else excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName) End If ' MsgBox(dr(dc.ColumnName)) ' excel.Cells(rowIndex + 1, colIndex).NumberFormat = "0.00" Next ' counter += 1 ' lb_pcnt.Text = Format(counter / Val(tb_count), "p") Next With wSheet.Range("A1", "Z1") .Font.Bold = True .HorizontalAlignment = Microsoft.Office.Interop.Excel.XlVAlign.xlVAlignCenter End With With wSheet.Range("A1", "Z1") .Font.Size = 10 End With wSheet.Columns.AutoFit() Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If Dim strFileName As String = sPath & "Data.xlsx" Dim blnFileOpen As Boolean = False Dim openok As Boolean = False Try Dim fileTemp As System.IO.FileStream = System.IO.File.OpenWrite(strFileName) fileTemp.Close() openok = True Catch ex As System.Exception blnFileOpen = False End Try Try If System.IO.File.Exists(strFileName) Then System.IO.File.Delete(strFileName) End If wBook.SaveAs(strFileName) Catch ex As System.Exception MsgBox(ex.Message) End Try excel.Quit() releaseObject(excel) releaseObject(wBook) releaseObject(wSheet) If openok Then Process.Start(sPath & "Data.xlsx") End Sub Private Sub releaseObject(ByVal obj As Object) Try System.Runtime.InteropServices.Marshal.ReleaseComObject(obj) obj = Nothing Catch ex As System.Exception obj = Nothing Finally GC.Collect() End Try End Sub Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click exportToExcel(dgvData) End Sub Private Sub btnAtillaDurmaz_Click(sender As Object, e As EventArgs) Handles btnAtillaDurmaz.Click Dim pf As New cProgramFunctions Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\Bürgschaften\" ' My.Computer.FileSystem.GetTempFileName If Not My.Computer.FileSystem.DirectoryExists(sPath) Then My.Computer.FileSystem.CreateDirectory(sPath) End If pf.genEXCEL_AuswertungenKW(sPath, cboAtillaDurmazKw.Text, cboAtillaDurmazYear.Text, True) End Sub Sub reset() cboDataBuerg.SelectedIndex = 0 cboDataStatVon.SelectedIndex = 0 cboDataStatBis.SelectedIndex = 2 cboDataNL.SelectedIndex = 0 datDataBis.Value = Now datDataVon.Value = Now End Sub Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click ' cboTage.SelectedIndex = 0 cboDataBuerg.SelectedIndex = 0 cboDataStatVon.SelectedIndex = 0 cboDataNL.SelectedIndex = 0 cboDataStatBis.SelectedIndex = 0 datDataBis.Value = Now datDataVon.Value = Now.AddMonths(-3) End Sub Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click cboDataBuerg.SelectedIndex = 1 cboDataStatVon.SelectedIndex = 0 cboDataNL.SelectedIndex = 0 cboDataStatBis.SelectedIndex = 0 datDataBis.Value = Now datDataVon.Value = Now.AddMonths(-3) End Sub Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click 'doJahresauswertung_KEWILL doJahresauswertung_DAKOSY() End Sub Sub doJahresauswertung_KEWILL() Me.Cursor = Cursors.WaitCursor Try Dim cBrgYear As New List(Of cBrgYear) Dim estr As String = "" Dim estrText As String = "" Dim zol_estr As String = "" Dim zol_estrText As String = "" If ComboBox2.Text = "" Then MsgBox("Bitte Jahr auswählen!") Me.Cursor = Cursors.Default Exit Sub End If Dim year As Integer = ComboBox2.Text For kw As Integer = 1 To 53 Dim aktdat As Date = CalendarWeek(kw, year) Dim b As New cBrgYear b.kw = kw Dim andstr_zabis As String = "" Dim andstr_zolaris As String = "" Dim bzol As Boolean = True Dim bzab As Boolean = True If cbxSUB.Checked Or cbxATILLA.Checked Or cbxSBG.Checked Or cbxWAI.Checked Or cbxDURMAZ.Checked Or cbxNKD.Checked Or cbxNEU.Checked Then bzol = False bzab = False andstr_zabis = " AND basman_nl IN ( " andstr_zolaris = " AND OperatorId IN ( " estr = "" estrText = "" zol_estr = "" zol_estrText = "" If cbxSUB.Checked Then estr &= " '" & cbxSUB.Text & "'," : estrText &= " 'SUB'," : bzab = True If cbxWAI.Checked Then estr &= " '" & cbxWAI.Text & "'," : estrText &= " 'WAI'," : bzab = True If cbxSBG.Checked Then estr &= " '" & cbxSBG.Text & "'," : estrText &= " 'SBG'," : bzab = True If cbxNEU.Checked Then estr &= " '" & cbxNEU.Text & "'," : estrText &= " 'NEU'," : bzab = True If cbxNKD.Checked Then estrText &= " 'NKD', " If cbxATILLA.Checked Then estr &= " 'SUW'," : estrText &= " 'ATILLA'," : bzab = True 'ATILLA If cbxDURMAZ.Checked Then estr &= " 'SUW'," : estrText &= " 'DURMAZ'," : bzab = True 'DURMAZ If estr.EndsWith(",") Then estr = estr.Substring(0, estr.Length - 1) If estrText.EndsWith(",") Then estrText = estrText.Substring(0, estrText.Length - 1) andstr_zabis &= estr & ") " If Not cbxATILLA.Checked = cbxDURMAZ.Checked Then If cbxATILLA.Checked Then andstr_zabis &= " AND veoant_beznr NOT LIKE 'DU%' " 'ATILLA If cbxDURMAZ.Checked Then andstr_zabis &= " AND veoant_beznr LIKE 'DU%' " 'DURMAZ End If 'ZOLARIS If cbxSUB.Checked Then zol_estr &= " '1', '4'," : bzol = True ' If cbxWAI.Checked Then zol_estr &= " '4'," : bzol = True If cbxSBG.Checked Then zol_estr &= " '2'," : bzol = True If cbxNKD.Checked Then zol_estr &= " '3'," : bzol = True If cbxATILLA.Checked Then zol_estr &= " '5', '6'," : bzol = True If zol_estr.EndsWith(",") Then zol_estr = zol_estr.Substring(0, zol_estr.Length - 1) andstr_zolaris &= zol_estr & ") " ' MsgBox(andstr_zabis & " - " & andstr_zolaris) End If ' " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.at__atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT, andstr_zabis)) If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.de_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE, andstr_zabis)) If cboSystemAuswertungJahrWo.Text <> "ATLAS" And bzol Then b.at_zolaris = BRG.getBrgSumFromFMZOLL_Zolaris(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT, andstr_zolaris) If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.de2_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zabis(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE_NEU, andstr_zabis)) ' b.at_zolaris = CDbl(0) cBrgYear.Add(b) Next If cbxSplitATLASZOLARIS.Checked Then genExcelYearSplitATLASEZOLL(cBrgYear, year, "AUSWERTUNG mit Einschränkung: " & estrText) Else genExcelYear(cBrgYear, year, "AUSWERTUNG mit Einschränkung: " & estrText) End If Catch ex As System.Exception MsgBox("Problem beim Verarbeiten der Jahresauswertung!" & vbNewLine & ex.Message) 'MsgBox(ex.StackTrace) End Try Me.Cursor = Cursors.Default End Sub Sub doJahresauswertung_DAKOSY() Me.Cursor = Cursors.WaitCursor Try Dim cBrgYear As New List(Of cBrgYear) Dim estr As String = "" Dim estrText As String = "" Dim zol_estr As String = "" Dim zol_estrText As String = "" If ComboBox2.Text = "" Then MsgBox("Bitte Jahr auswählen!") Me.Cursor = Cursors.Default Exit Sub End If Dim year As Integer = ComboBox2.Text For kw As Integer = 1 To 53 Dim aktdat As Date = CalendarWeek(kw, year) Dim b As New cBrgYear b.kw = kw Dim andstr_zabis As String = "" Dim andstr_zolaris As String = "" Dim bzol As Boolean = True Dim bzab As Boolean = True If cbxSUB.Checked Or cbxATILLA.Checked Or cbxSBG.Checked Or cbxWAI.Checked Or cbxDURMAZ.Checked Or cbxNKD.Checked Or cbxNEU.Checked Then bzol = False bzab = True 'andstr_zabis = " AND basman_nl IN ( " andstr_zolaris = " AND OperatorId IN ( " estr = "" 'estrText = "" zol_estr = "" zol_estrText = "" 'If cbxSUB.Checked Then estr &= " '" & cbxSUB.Text & "'," : estrText &= " 'SUB'," : bzab = True 'If cbxWAI.Checked Then estr &= " '" & cbxWAI.Text & "'," : estrText &= " 'WAI'," : bzab = True 'If cbxSBG.Checked Then estr &= " '" & cbxSBG.Text & "'," : estrText &= " 'SBG'," : bzab = True 'If cbxNEU.Checked Then estr &= " '" & cbxNEU.Text & "'," : estrText &= " 'NEU'," : bzab = True 'If cbxNKD.Checked Then estrText &= " 'NKD', " 'If cbxATILLA.Checked Then estr &= " 'SUW'," : estrText &= " 'ATILLA'," : bzab = True 'ATILLA 'If cbxDURMAZ.Checked Then estr &= " 'SUW'," : estrText &= " 'DURMAZ'," : bzab = True 'DURMAZ 'If estr.EndsWith(",") Then estr = estr.Substring(0, estr.Length - 1) 'If estrText.EndsWith(",") Then estrText = estrText.Substring(0, estrText.Length - 1) ' andstr_zabis &= estr & ") " 'If Not cbxATILLA.Checked = cbxDURMAZ.Checked Then ' If cbxATILLA.Checked Then andstr_zabis &= " AND ncts_ObjectName NOT LIKE 'DU%' " 'ATILLA ' If cbxDURMAZ.Checked Then andstr_zabis &= " AND ncts_ObjectName LIKE 'DU%' " 'DURMAZ 'End If If cbxATILLA.Checked Then andstr_zabis &= " AND ncts_ObjectName LIKE '4801%' " 'ATILLA If cbxDURMAZ.Checked Then andstr_zabis &= " AND ncts_ObjectName LIKE 'DU%' " 'DURMAZ 'ZOLARIS If cbxSUB.Checked Then zol_estr &= " '1', '4'," : bzol = True ' If cbxWAI.Checked Then zol_estr &= " '4'," : bzol = True If cbxSBG.Checked Then zol_estr &= " '2'," : bzol = True If cbxNKD.Checked Then zol_estr &= " '3'," : bzol = True If cbxATILLA.Checked Then zol_estr &= " '5', '6'," : bzol = True If zol_estr.EndsWith(",") Then zol_estr = zol_estr.Substring(0, zol_estr.Length - 1) andstr_zolaris &= zol_estr & ") " ' MsgBox(andstr_zabis & " - " & andstr_zolaris) End If ' " AND veoant_beznr NOT LIKE 'DU%' AND basman_nl='SUW' If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.at__atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zodiak(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT, andstr_zabis)) If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.de_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zodiak(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE, andstr_zabis)) If cboSystemAuswertungJahrWo.Text <> "ATLAS" And bzol Then b.at_zolaris = BRG.getBrgSumFromFMZOLL_Zolaris(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_AT, andstr_zolaris) If cboSystemAuswertungJahrWo.Text <> "ZOLARIS" And bzab Then b.de2_atlas = toDbl(BRG.getBrgSumFromFMZOLL_Zodiak(aktdat.ToShortDateString, aktdat.AddDays(6).ToShortDateString, "50", "60", brg_DE_NEU, andstr_zabis)) ' b.at_zolaris = CDbl(0) cBrgYear.Add(b) Next If cbxSplitATLASZOLARIS.Checked Then genExcelYearSplitATLASEZOLL(cBrgYear, year, "AUSWERTUNG mit Einschränkung: " & estrText) Else genExcelYear(cBrgYear, year, "AUSWERTUNG mit Einschränkung: " & estrText) End If Catch ex As System.Exception MsgBox("Problem beim Verarbeiten der Jahresauswertung!" & vbNewLine & ex.Message & ex.StackTrace) 'MsgBox(ex.StackTrace) End Try Me.Cursor = Cursors.Default End Sub Function toDbl(o) As Double Try If o.ToString <> "" Then Return CDbl(o) End If Catch ex As System.Exception End Try Return 0 End Function Dim email As Boolean = False Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click email = True btnExcel_Click(btnExcel, New EventArgs) End Sub Dim WithEvents EItem As Microsoft.Office.Interop.Outlook.MailItem Private Sub sendPerMail(path) Dim NSpace As Microsoft.Office.Interop.Outlook.NameSpace Dim Folder As Microsoft.Office.Interop.Outlook.MAPIFolder Dim outApp As Microsoft.Office.Interop.Outlook.Application outApp = New Microsoft.Office.Interop.Outlook.Application NSpace = outApp.GetNamespace("MAPI") Folder = NSpace.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderSentMail) EItem = Folder.Items.Add(Microsoft.Office.Interop.Outlook.OlItemType.olMailItem) EItem.To = "jl@verag.ag" EItem.Subject = "Auswertung der Bürgschaften" EItem.Body = "Hallo," & vbNewLine _ & vbNewLine _ & "anbei die Auswertung der Bürgschaften." & vbNewLine _ & vbNewLine _ & vbNewLine _ & vbNewLine _ & "Mit freundlichen Grüßen" & vbNewLine _ & vbNewLine _ & "Andreas Luxbauer" & vbNewLine _ & vbNewLine _ & vbNewLine _ & vbNewLine _ & "VERAG Spedition AG" & vbNewLine _ & "A 4975 Suben 100" & vbNewLine _ & vbNewLine _ & "T +43 7711 2777-35" & vbNewLine _ & "F +43 7711 2777-28" & vbNewLine _ & "@ al@verag.ag" & vbNewLine _ & " www.verag.ag" EItem.Attachments.Add(path, OlAttachmentType.olByValue, 1, "Auswertung.xlsx") EItem.Display(False) 'öffnet das 'neue E-Mail-Form' von Outlook End Sub End Class Class cBrgYear Property kw As Integer Property de_atlas As Double Property de2_atlas As Double Property at__atlas As Double Property at_zolaris As Double End Class Public Class topValues Property warenwert As String Property sicherheitsbetrag As String End Class