Imports System.IO Imports System.Windows.Forms Imports Parkzeit.cMeineFunktionen Imports System.Data.SqlClient Imports System.ComponentModel Imports System.Text Imports VERAG_PROG_ALLGEMEIN Public Class frmMain Public Shared ConnStr As String Public Shared ConnStrInfo As String Public Shared Aktive_ID As Integer Public Shared Optionen As New cOptionen Public Shared Ausgewählte_Zeile As Integer = 0 Private Parkzeiten As New cParkzeitenDAL Private locZeilen As Integer = -1 Private Anzahl As Integer Private Grid_aktiv As Boolean = False Private Suche_freigegeben As Boolean = False Dim LEISTUNGSNR_PARKEN As Integer = 313 Dim OFFERETNNR_PARKEN As Integer = 18 Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Private Sub frmMain_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load 'InitializeComponent() Icon = GetProgrammIcon() cboTarif.fillWithSQL("SELECT distinct([TarifArt]) ,TarifArt FROM [Parkzeiten]", False, "PARKZEIT") ''aktuelle DB zuweisen 'Dim pfadDatei As String = "C:\Projekte.NET\Verag\Parkzeit\Parkzeit.accdb" ' If Not File.Exists(pfadDatei) Then 'MsgBox("nicht gefunden: " & pfadDatei) 'Sonderfall zum Debuggen 'pfadDatei = Application.StartupPath & "\Parkzeit.accdb" ' End If ' If Not File.Exists(pfadDatei) Then 'MsgBox("Auf die Datenbank '" & pfadDatei & "' konnte nicht zugegriffen werden!" & vbCrLf & vbCrLf & _ ' "Bitte verständigen Sie den zuständigen Administrator.", vbExclamation, "Fehler Datenbank") ' Environment.Exit(0) 'Me.Close() ' End If 'ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & pfadDatei 'ConnStr = "Provider=SQLOLEDB;Server=DEVELOPER\DEVSQL;Database=Parkzeit;uid=sa;Password=BmWr501956;" 'Dim tmp As String 'tmp = "Provider=SQLOLEDB;Server=DEVELOPER\DEVSQL;Database=Parkzeit;" ' ConnStrInfo = tmp & "uid=**;password=*********" ' ConnStr = tmp & "uid=sa;password=BmWr501956" 'Server=DEVELOPER\DEVSQL;database=Parkzeit;User ID=sa;Pwd=BmWr501956 'jetzt noch Optionen laden Dim OptionenDAL As New cOptionenDAL Optionen = OptionenDAL.LesenOptionen() If IsNothing(Optionen) Then MsgBox("Fehler beim Laden der Optionen. Standardwerte werden eventuell nicht richtig vorgegeben.", vbCritical) Me.Close() End If 'Position+Größe wird in ApplicationSettings vom Formular gespeichert Try ' Me.Size = My.Settings.frmMainSize ' Me.Location = My.Settings.frmMainPosition Catch ex As Exception 'nix tun - Standardgröße wird somit automatisch gesetzt End Try 'Vorschlagswerte vergeben dtpVon.Value = DateSerial(Now.Date.AddMonths(-1).Year, Now.Date.AddMonths(-1).Month, 1) dtpBis.Value = Now.Date.AddDays(1) 'txtKosten.Text = Format(Optionen.Kosten_je_Stunde, "#0.00") dtpVon.Refresh() dtpBis.Refresh() 'txtKosten.Refresh() Grid_aktiv = True Tabelle_anzeigen() ' Spalten_festlegen() 'AL: Hat Fehler beim Start ausgelöst, wenn keine Daten vorhanden. Suche_freigegeben = True End Sub Private Sub frmMain_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed My.Settings.frmMainSize = Me.Size My.Settings.frmMainPosition = Me.Location My.Settings.Save() ' Application.Exit() End Sub Public Sub Tabelle_anzeigen() Dim msStart As Long = CLng((DateTime.Now - New DateTime(1970, 1, 1)).TotalMilliseconds) 'Paint wieder reaktivieren locZeilen = -1 If Not Grid_aktiv Then Exit Sub 'je nach Auswahl SQL anpassen Dim hSQL As String = "SELECT * FROM Parkzeiten WHERE Von >= " & SQLDatum(dtpVon.Value) & " AND Von <= " & SQLDatum(dtpBis.Value.AddDays(1)) If txtSuche.Text <> "" Then hSQL += " AND Kennzeichen LIKE '%" & txtSuche.Text & "%'" End If If txtKdNr.Visible AndAlso txtKdNr.Text <> "" Then hSQL += " AND KundenNr LIKE '%" & txtKdNr.Text & "%'" End If hSQL += " AND TarifArt='" & cboTarif._value & "'" hSQL += " ORDER BY Laufende_Nr, Von" gridParkzeiten.DataSource = Parkzeiten.AnzeigeTabelle(hSQL) 'Tabelle Kommt/Geht bereinigen If gridParkzeiten.RowCount = 0 Then gridParkzeiten.DataSource = Nothing Else Spalten_festlegen() 'AL: Sortierung nach Ausfahrt (Zeit) gridParkzeiten.Sort(gridParkzeiten.Columns(3), ListSortDirection.Descending) End If 'Anzeige der Anzahl gewählter/aller Datensätze lblAnzahl.Text = Format(gridParkzeiten.RowCount, "#,##0") & " ausgewählt" lblAnzahl.Refresh() Dim msEnd As Long = CLng((DateTime.Now - New DateTime(1970, 1, 1)).TotalMilliseconds) Label1.Text = "" & (msEnd - msStart) & " ms" End Sub Private Sub Spalten_festlegen() With gridParkzeiten .Columns(0).Visible = False 'ID nicht anzeigen .Columns(1).Width = 50 .Columns(1).HeaderText = "lfd.Nr" .Columns(1).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleCenter .Columns(2).Width = 120 .Columns(2).HeaderText = "Einfahrt" .Columns(2).DefaultCellStyle.Format = "dd.MM.yyyy HH:mm" .Columns(3).Width = 120 .Columns(3).HeaderText = "Ausfahrt" .Columns(3).DefaultCellStyle.Format = "dd.MM.yyyy HH:mm" .Columns(4).Width = 80 .Columns(4).HeaderText = "Dauer Std" .Columns(4).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleCenter .Columns(5).Visible = False 'Dauer in Minuten wird nicht angezeigt .Columns(6).Width = 300 .Columns(6).HeaderText = "LKW-Kennzeichen" End With End Sub Private Sub btnInfo_Click(sender As System.Object, e As System.EventArgs) Handles btnInfo.Click Dim f As New frmInfo f.ShowDialog(Me) End Sub Private Sub btnErfassen_Click(sender As System.Object, e As System.EventArgs) Handles btnErfassen.Click Dim f As New frmEintragParkzeit Aktive_ID = 0 'neue Einträge f.ShowDialog(Me) End Sub Private Sub btnAuswerten_Click(sender As System.Object, e As System.EventArgs) Handles btnAuswerten.Click Dim f As New frmAuswahl_Abrechnung f.cboTarif.changeItem(cboTarif._value) f.ShowDialog(Me) End Sub Private Sub dtpDatum_ValueChanged(sender As System.Object, e As System.EventArgs) Handles dtpVon.ValueChanged, dtpBis.ValueChanged If Not Suche_freigegeben Then Exit Sub Tabelle_anzeigen() End Sub Private Sub txtSuche_TextChanged(sender As System.Object, e As System.EventArgs) Handles txtSuche.TextChanged, txtKdNr.TextChanged If Not Suche_freigegeben Then Exit Sub Tabelle_anzeigen() End Sub Private Sub gridParkzeiten_CellMouseClick(sender As Object, e As System.Windows.Forms.DataGridViewCellMouseEventArgs) Handles gridParkzeiten.CellMouseClick 'Bei Rechtsklick mit Maus die betroffene Zeile markieren If e.RowIndex < 0 Then Exit Sub 'Es wurde außerhalb einer gültigen Datenzeile geklickt If e.Button = Windows.Forms.MouseButtons.Right Then gridParkzeiten.CurrentCell = gridParkzeiten.Rows(e.RowIndex).Cells(e.ColumnIndex) ContextMenuStrip1.Show(Windows.Forms.Cursor.Position) End If End Sub Private Sub gridParkzeiten_DoubleClick(sender As Object, e As System.EventArgs) Handles gridParkzeiten.DoubleClick Try Aktive_ID = CInt(gridParkzeiten.Rows(gridParkzeiten.CurrentRow.Index).Cells("ParkzeitID").Value) Ausgewählte_Zeile = gridParkzeiten.CurrentRow.Index Dim f As New frmEintragParkzeit f.ShowDialog(Me) 'falls Änderung, dann die neuen Werte in Grid anzeigen If Ausgewählte_Zeile >= 0 Then Dim hParkzeit As cParkzeit = Parkzeiten.LesenParkzeit(Aktive_ID, "") If Not IsNothing(hParkzeit) Then gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(1).Value = hParkzeit.Laufende_Nr gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(2).Value = hParkzeit.Von gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(3).Value = hParkzeit.Bis gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(4).Value = hParkzeit.Dauer gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(5).Value = hParkzeit.Dauer_Minuten gridParkzeiten.Rows(Ausgewählte_Zeile).Cells(6).Value = hParkzeit.Kennzeichen End If End If Catch ex As Exception End Try End Sub Private Sub mnuLöschen_Click(sender As System.Object, e As System.EventArgs) Handles mnuLöschen.Click Aktive_ID = CInt(gridParkzeiten.Rows(gridParkzeiten.CurrentRow.Index).Cells("ParkzeitID").Value) Dim antwort = MsgBox("Möchten Sie die ausgewählte Parkzeit wirklich löschen?", CType(vbQuestion + vbYesNo + vbDefaultButton2, MsgBoxStyle), "Bilanzeintrag löschen") If antwort = vbNo Then Exit Sub Parkzeiten.LöschenParkZeit(Aktive_ID) Tabelle_anzeigen() End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Dim conString As String 'conString = "Server=BEVPC\SQLExpress;database=MSDNSolve;Integrated Security=true" conString = "Server=DEVELOPER\DEVSQL;database=Parkzeit;User ID=sa;Pwd=BmWr501956;" 'Application Name=MyApp Dim con As SqlConnection = Nothing Try con = New SqlConnection(conString) con.Open() MessageBox.Show("Offen") Catch ex As Exception MessageBox.Show(ex.Message) Finally If con.State <> ConnectionState.Closed Then con.Close() End Try con.Dispose() ' myConnection.ConnectionString = "Server=DEVELOPER\DEVSQL;Database=Parkzeit;Uid=sa;Pwd=BmWr501956;" End Sub Private Sub cboTarif_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cboTarif.SelectedIndexChanged If Not Suche_freigegeben Then Exit Sub Tabelle_anzeigen() Select Case cboTarif._value Case "WABERERS" picLogo.Image = My.Resources.Logo_Waberer Label5.Visible = False txtKdNr.Visible = False Case Else picLogo.Image = My.Resources.Verag_AG_Logo Label5.Visible = True txtKdNr.Visible = True End Select End Sub Private Sub btnDatenEinlesen_Click(sender As Object, e As EventArgs) Handles btnDatenEinlesen.Click Dim f As New frmParkzeitImport f.ShowDialog(Me) Tabelle_anzeigen() End Sub Private Sub frmMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown cboTarif.changeItem("WABERERS") End Sub Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click doRechnungslauf(True) End Sub Sub doRechnungslauf(Optional fakturieren As Boolean = False) Try ProgressBar1.Visible = True Me.Cursor = Cursors.WaitCursor Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Dim rootFolder = "" If Not fakturieren Then '"Bitte geben Dim fd As New FolderBrowserDialog If fd.ShowDialog(Me) = DialogResult.OK Then rootFolder = fd.SelectedPath End If If rootFolder = "" Then Me.Cursor = Cursors.Default : Exit Sub End If If cboTarif._value = "WABERERS" Then '======================================== 'Alle Waberers-Einträge mit der Waberers KdNr ergänzen SQL.doSQL("UPDATE [Parkzeit].[dbo].[Parkzeiten] set KundenNr='717981' WHERE TarifArt='WABERERS' AND KundenNr is null", "PARKZEIT") '======================================== End If 'Kunden durchlaufen: Dim hSQLKd As String = "SELECT DISTINCT(KundenNr) FROM Parkzeiten WHERE Von >= " & SQLDatum(dtpVon.Value) & " AND Von <= " & SQLDatum(dtpBis.Value.AddDays(1)) & " AND TarifArt='" & cboTarif._value & "' " If txtSuche.Text <> "" Then hSQLKd += " AND Kennzeichen LIKE '%" & txtSuche.Text & "%'" If txtKdNr.Visible AndAlso txtKdNr.Text <> "" Then hSQLKd += " AND KundenNr LIKE '%" & txtKdNr.Text & "%'" Dim dtKd = SQL.loadDgvBySql(hSQLKd, "PARKZEIT") If dtKd Is Nothing OrElse dtKd.Rows.Count = 0 Then MsgBox("Keine Daten!") Me.Cursor = Cursors.Default : Exit Sub End If If fakturieren Then If Not vbYes = MsgBox("Es werden " & dtKd.Rows.Count & " Kunden abgerechnet. Möchten Sie fortfahren?", vbYesNoCancel) Then MsgBox("Keine Daten!") Me.Cursor = Cursors.Default : Exit Sub End If End If ProgressBar1.Minimum = 1 ProgressBar1.Maximum = dtKd.Rows.Count ProgressBar1.Value = 1 For Each r As DataRow In dtKd.Rows Dim KdNr = r("KundenNr") 'Zusammenbau der SQL-Abfrage Dim hSQL As String = "SELECT * FROM Parkzeiten WHERE Von >= " & SQLDatum(dtpVon.Value) & " AND Von <= " & SQLDatum(dtpBis.Value.AddDays(1)) Dim hauswahl As String = "Auswahl: " If cboTarif._value = "WABERERS" Then hauswahl &= "alle" Else hauswahl = "Kunde: " & KdNr.ToString & " " & SQL.getValueTxtBySql("SELECT TOP 100 [Name 1] + isnull([Name 2],'')+ ', ' + isnull(ort,'') FROM [Adressen] where adressennr='" & KdNr.ToString & "' ", "FMZOLL",,, "0") End If hSQL += " AND TarifArt='" & cboTarif._value & "' " If KdNr.ToString <> "" Then hSQL += " AND KundenNr='" & KdNr.ToString & "' " hSQL += " AND TarifArt='" & cboTarif._value & "' " If txtSuche.Text <> "" Then hSQL += " AND Kennzeichen LIKE '%" & txtSuche.Text & "%'" End If If txtKdNr.Visible AndAlso txtKdNr.Text <> "" Then hSQL += " AND KundenNr LIKE '%" & txtKdNr.Text & "%'" End If hSQL += " ORDER BY Laufende_Nr" Dim Auswertung As New frmDruckansicht Dim Parkzeiten = New cParkzeitenDAL Dim Kosten As Double = 0.4 '!!!!!!!Standard!!!!!!! If KdNr.ToString = "717981" Then Kosten = 0.3 'Waberers If KdNr.ToString = "402608" Then Kosten = 0.3 'Nexways If KdNr.ToString = "402507" Then Kosten = 0.5 'TP Omerbasic Dim KostenTmp = SQL.getValueTxtBySql("SELECT TOP 1 Preis FROM [Offertenpositionen] where KundenNr='" & KdNr.ToString & "' and OffertenNr='" & OFFERETNNR_PARKEN.ToString & "' and LeistungsNr='" & LEISTUNGSNR_PARKEN.ToString & "' and Preis is not null", "FMZOLL",,, -1) If CDbl(KostenTmp) >= 0 Then Kosten = CDbl(KostenTmp) End If hauswahl &= vbNewLine & "Tarif: " & Kosten.ToString("C2") & " / Stunde " Dim hKosten As Double = 0 Dim hSummeZeit = 0 Dim hAnzahl = 0 Using conn As SqlConnection = cDatenbank.GetNewOpenConnection() Using cmd As New SqlCommand(hSQL, conn) Dim dr = cmd.ExecuteReader() 'AL: ERR If Not IsNothing(dr) Then While dr.Read() hSummeZeit += VarToInt(dr.Item("Dauer_Minuten")) hAnzahl += 1 End While End If End Using End Using Dim studnen2St As Double = CDbl(CDbl(hSummeZeit / 60).ToString("N2")) hKosten = studnen2St * VarToDbl(Kosten) Dim hGesamtdauer As String = Minuten_auf_Text(hSummeZeit) Dim hGesamtkosten As String = Format(hKosten, "€ #,##0.00") Select Case cboTarif._value Case "WABERERS" Auswertung.BefüllenAbrechnung("Auswertung Parkzeiten Waberer's LKWs", Parkzeiten.LeseParkzeitenFürDruck(hSQL, VarToDbl(Kosten)), cboTarif._value, hauswahl, hGesamtdauer, hGesamtkosten) Case "VERAG" Auswertung.BefüllenAbrechnung("Auswertung Parkzeiten LKWs", Parkzeiten.LeseParkzeitenFürDruck(hSQL, VarToDbl(Kosten)), cboTarif._value, hauswahl, hGesamtdauer, hGesamtkosten) End Select If Not fakturieren Then '======================================== 'nur PDFs in selektierten Ordner '======================================== Dim fileName = KdNr.ToString & "_Parking_" & dtpVon.Value.ToShortDateString & "-" & dtpBis.Value.ToShortDateString Dim filePath = rootFolder & "\" & fileName & ".pdf" Auswertung.genPDF(filePath) Else '======================================== 'SpedBucheintrag '======================================== Dim SPEDBUCH As New VERAG_PROG_ALLGEMEIN.cSpeditionsbuch genPARK_SPEDBUCH_ByKdNr(KdNr.ToString, dtpVon.Value, dtpBis.Value, SPEDBUCH) '======================================== 'Rechnungserstellung '======================================== Dim RECHNUNG As New VERAG_PROG_ALLGEMEIN.cRechnungsausgang If genPARK_RECHNUNG_BySPEDBUCH(KdNr.ToString, SPEDBUCH, dtpVon.Value, dtpBis.Value, Kosten, studnen2St, RECHNUNG) Then '======================================== 'Rechnungsanhang '======================================== Dim fileName = "Parking_" & dtpVon.Value.ToShortDateString & "-" & dtpBis.Value.ToShortDateString & ".pdf" Dim filePath = DATENVERVER_OPTIONS.getTMPPath(fileName, ".pdf", False, False) If Auswertung.genPDF(filePath) Then If IO.File.Exists(filePath) Then Dim DS As New VERAG_PROG_ALLGEMEIN.cDATENSERVER("DOKUMENTE", "MDM", "PARPLATZ_ABRECHNUNG", "", "", fileName, KdNr.ToString, False) 'Now.ToString("ddMMyy_HHmmss.ffff") If Not DS.uploadDataToDATENSERVER(filePath) Then MsgBox("Fehler beim Speichern: Datenserver! KDNR:" & KdNr.ToString) If CInt(DS.da_id) <= 0 Then MsgBox("Keine DocId!") Dim da_id = DS.da_id Dim destPath = DS.GET_TOP1_PATH 'If AvisoId > 0 And SendungsId > 0 Then ' Dim fi As New FileInfo(PdfTmp) ' Dim ANH As New VERAG_PROG_ALLGEMEIN.cAvisoAnhaenge(AvisoId, fileName, DS.da_id, "EORI", "PDF", SendungsId, , fi.Length) ' If Not ANH.SAVE Then MsgBox("Fehler beim Anhang speichern!") : Return False ' Dim anhId = ANH.anh_id 'End If 'Return destPath If RECHNUNG IsNot Nothing Then RECHNUNG.ANHAENGE.Clear() Dim ANH As New VERAG_PROG_ALLGEMEIN.cRechnungsausgangAnhaenge ANH.dsId = CInt(DS.da_id) ANH.Bezeichnung = fileName RECHNUNG.ANHAENGE.Add(ANH) RECHNUNG.SAVE_ANHAENGE(RECHNUNG.RK_ID) End If End If End If End If '======================================== '======================================== End If ProgressBar1.PerformStep() Me.Refresh() Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) ProgressBar1.Visible = False End Try Me.Cursor = Cursors.Default End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click doRechnungslauf(False) End Sub Function genPARK_SPEDBUCH_ByKdNr(KdNr As String, von As Date, bis As Date, ByRef SPEDBUCH As VERAG_PROG_ALLGEMEIN.cSpeditionsbuch) As Boolean Try Dim Abfertigungsdatum = bis Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(KdNr) SPEDBUCH = New VERAG_PROG_ALLGEMEIN.cSpeditionsbuch Select Case cboTarif._value Case "WABERERS" AD = New VERAG_PROG_ALLGEMEIN.cAdressen(402608) End Select Dim OffertenNr = OFFERETNNR_PARKEN Dim Abfertigungsart = 10 SPEDBUCH.FilialenNr = 4819 SPEDBUCH.AbfertigungsNr = VERAG_PROG_ALLGEMEIN.cAllgemein.getMaxPosNrIncrement(SPEDBUCH.FilialenNr, Now.Year) SPEDBUCH.NewUNTER_NR() SPEDBUCH.Vermittler = AD.Ordnungsbegriff.ToString SPEDBUCH.VermittlerKundenNr = KdNr SPEDBUCH.VermittlerOffertenNr = OffertenNr SPEDBUCH.Abfertigungsdatum = Abfertigungsdatum.ToShortDateString SPEDBUCH.Abfertigungsart = Abfertigungsart SPEDBUCH.Bar = False SPEDBUCH.Fakturiert = True SPEDBUCH.AnzahlSonstiges = 1 SPEDBUCH.Abfertigungsanzahl = 1 SPEDBUCH.Währungsschlüssel = 900 SPEDBUCH.Packstücke = "Parkplatzgebühr " & von.ToShortDateString & " - " & bis.ToShortDateString SPEDBUCH.AvisUhrzeit = Nothing SPEDBUCH.Umrechnungskurs = Nothing SPEDBUCH.veoerz_basbtg = Nothing SPEDBUCH.Sicherheitsbetrag = Nothing SPEDBUCH.Sachbearbeiter = VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME Return SPEDBUCH.SAVE Catch ex As System.Exception MsgBox(ex.Message & ex.StackTrace) End Try Return False End Function Function genPARK_RECHNUNG_BySPEDBUCH(KdNr As String, SPEDBUCH As VERAG_PROG_ALLGEMEIN.cSpeditionsbuch, von As Date, bis As Date, KostenStd As Double, Std As Double, ByRef RECHNUNG As VERAG_PROG_ALLGEMEIN.cRechnungsausgang) As Boolean Try Dim AD As New VERAG_PROG_ALLGEMEIN.cAdressen(SPEDBUCH.VermittlerKundenNr) Dim KD As New VERAG_PROG_ALLGEMEIN.cKunde(SPEDBUCH.VermittlerKundenNr) Dim RG As New VERAG_PROG_ALLGEMEIN.cRechnungsausgang Select Case cboTarif._value Case "WABERERS" AD = New VERAG_PROG_ALLGEMEIN.cAdressen(402608) KD = New VERAG_PROG_ALLGEMEIN.cKunde(402608) End Select Dim OffertenNr = OFFERETNNR_PARKEN Dim Abfertigungsart = 10 RG.FilialenNr = SPEDBUCH.FilialenNr RG.AbfertigungsNr = SPEDBUCH.AbfertigungsNr RG.SpeditionsbuchUnterNr = SPEDBUCH.UnterNr RG.UnterNr = RG.getMaxRGUnterNr() RG.Buchungsjahr = getGJ(CDate(SPEDBUCH.Abfertigungsdatum)) 'If(Now.Month = 1, Now.Year - 1, Now.Year) RG.FilialenNr = SPEDBUCH.FilialenNr RG.Abfertigungsdatum = CDate(SPEDBUCH.Abfertigungsdatum) RG.Sammelrechnung = 0 'EINZELRG!' RG.BelegartenKz = "AR" RG.BelegartenNr = 70 RG.BelegartenBez = "Rechnung" RG.Vorzeichen = "+" RG.Packstücke_und_Warenbezeichnung = SPEDBUCH.Packstücke RG.VermittlerKundenNr = AD.AdressenNr RG.VermittlerLandKz = AD.LandKz RG.VermittlerName_1 = AD.Name_1 RG.VermittlerName_2 = AD.Name_2 RG.VermittlerOffertenNr = OffertenNr RG.VermittlerOrt = (If(AD.LandKz.ToString, "") & " " & If(AD.PLZ.ToString, "") & " " & If(AD.Ort.ToString, "")) RG.VermittlerStraße = AD.Straße RG.Rechnung_an = 3 RG.OffertenNr = OffertenNr RG.KundenNrZentrale = KD.KundenNrZentrale RG.RechnungsKundenNr = CInt(AD.AdressenNr) RG.RechnungsLandKz = AD.LandKz RG.RechnungsName_1 = AD.Name_1 RG.RechnungsName_2 = AD.Name_2 RG.RechnungsOrt = (If(AD.LandKz.ToString, "") & " " & If(AD.PLZ.ToString, "") & " " & If(AD.Ort.ToString, "")) RG.RechnungsStraße = AD.Straße RG.RechnungsUstIdKz = AD.UstIdKz RG.RechnungsUstIdNr = AD.UstIdNr RG.RechnungsUstIdGeprüft = AD.UstIdGeprüft RG.Lastschrift = KD.Lastschrift RG.Kunden_SVS = KD.SVS RG.Steuerschlüssel = CInt(KD.Steuerschlüssel) RG.ForceSteuerschlüssel = 19 ' Überschrieben --> IMMER 19% verwenden!! RG.Vorkasse = KD.Vorkasse RG.Vorlageprovision_Proz = KD.Vorlageprovision RG.Kreditaufwendungen_Proz = KD.Kreditaufwendungen RG.RechnungSprache = "DE" RG.Anlage_1 = "Aufstellung Parkgebühren" RG.Anlage_2 = "" RG.Anlage_3 = "" RG.Anlage_4 = "" RG.Anlage_5 = "" RG.Anlage_6 = "" RG.Text = "" RG.EMailRechnungstext = Nothing ' "" RG.Firma_ID = 4 RG.Nettozahlungsziel = KD.Zahlungsziel RG.SteuerpflichtigerGesamtbetrag = 0 RG.SteuerfreierGesamtbetrag = 0 RG.Status = 0 RG.[Vorkosten] = 0 RG.[Erlös] = 0 RG.[Buchungsjahr] = 0 RG.[Währungscode] = "EUR" RG.ReErfZeitstempel = Now RG.Sachbearbeiter = VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME RG.Buchungsjahr = getGJ(CDate(SPEDBUCH.Abfertigungsdatum)) Dim dtSt As DataTable = SQL.loadDgvBySql("SELECT TOP 1 isnull([Steuersatz %],0),isnull([Steuerbezeichnung],'') FROM [Steuertabelle] WHERE [Steuerschlüssel]='" & RG.Steuerschlüssel & "'", "FMZOLL") If dtSt IsNot Nothing AndAlso dtSt.Rows.Count > 0 Then RG.Steuersatz_Proz = CDbl(dtSt.Rows(0)(0)) End If '================================================== '====================POSITIONEN==================== '================================================== '================================================== '== Standard laden: Dim dtBestPOS = SQL.loadDgvBySql("SELECT * FROM [Offertenpositionen] where OffertenNr='" & OffertenNr & "' and KundenNr='" & KdNr & "' and Anzahl>0 and preis>0 ", "FMZOLL") If dtBestPOS IsNot Nothing Then For Each r As DataRow In dtBestPOS.Rows Dim POS_TMP As New VERAG_PROG_ALLGEMEIN.cRechnungsausgangPositionen POS_TMP.LeistungsNr = CInt(r("LeistungsNr")) POS_TMP.LeistungsBez = If(r("LeistungsBez").ToString, "") POS_TMP.BerechnungsartNr = CInt(r("BerechnungsartNr")) POS_TMP.Preis = If(r("Preis") Is DBNull.Value, 0, CDbl(r("Preis").ToString.Replace(".", ""))) POS_TMP.Anzahl = If(r("Anzahl") Is DBNull.Value, 0, r("Anzahl")) POS_TMP.BGebLeistungsNr = r("BGebLeistungsNr") POS_TMP.BGebProzent = r("BGebProzent") POS_TMP.BGebMinBetrag = r("BGebMinBetrag") POS_TMP.Steuerpflichtig = True 'CBool(LEISTUNG.Steuerpflichtig) Dim NettobetragTMP As Double = CDbl(POS_TMP.Preis) * CDbl(POS_TMP.Anzahl) Dim BruttoBetragTMP As Double = CDbl((NettobetragTMP + (NettobetragTMP * RG.Steuersatz_Proz / 100)).ToString("N2")) POS_TMP.BGebBgl = NettobetragTMP If POS_TMP.Steuerpflichtig Then POS_TMP.SteuerpflichtigerBetrag = CDec(NettobetragTMP) Else POS_TMP.SteuerfreierBetrag = CDec(BruttoBetragTMP) End If RG.POSITIONEN.Add(POS_TMP) Next End If '================================================== Dim POS As New VERAG_PROG_ALLGEMEIN.cRechnungsausgangPositionen() Dim LEISTUNG As New VERAG_PROG_ALLGEMEIN.cLeistungen(LEISTUNGSNR_PARKEN) 'Dim POS = RECHNUNG.POSITIONEN.Find(Function(x) x.LeistungsNr = 313) 'If POS Is Nothing Then ' POS = New VERAG_PROG_ALLGEMEIN.cRechnungsausgangPositionen() ' RG.POSITIONEN.Add(POS) 'End If POS.LeistungsNr = LEISTUNGSNR_PARKEN POS.LeistungsBez = "Parkplatz " & Std & " Std x " & KostenStd.ToString("C2") Dim Nettobetrag As Double = CDbl((KostenStd * Std).ToString("N2")) Dim BruttoBetrag As Double = CDbl((Nettobetrag + (Nettobetrag * RG.Steuersatz_Proz / 100)).ToString("N2")) POS.BerechnungsartNr = CInt(LEISTUNG.BerechnungsartNr) 'POS.Preis = BruttoBetrag POS.Anzahl = 1 POS.Steuerpflichtig = True 'CBool(LEISTUNG.Steuerpflichtig) POS.BGebBgl = Nettobetrag If POS.Steuerpflichtig Then POS.SteuerpflichtigerBetrag = CDec(Nettobetrag) POS.Preis = Nettobetrag Else POS.SteuerfreierBetrag = CDec(BruttoBetrag) POS.Preis = CDec(BruttoBetrag) End If POS.BGebLeistungsNr = LEISTUNGSNR_PARKEN POS.BGebProzent = Nothing POS.BGebMinBetrag = Nothing '================================================== RG.SteuerpflichtigerGesamtbetrag = POS.SteuerpflichtigerBetrag RG.SteuerfreierGesamtbetrag = POS.SteuerfreierBetrag RG.POSITIONEN.Add(POS) ' cFakturierung.setGesamtBetraege(RG) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' RG.Text = (cFakturierung.przRechnungstextTXT(RG, SPEDBUCH) & vbNewLine & cFakturierung.przRechnungstextZZ(RG)).Trim 'Call usrCntlFaktAbrechnung.przFixeTaxe(RG) ' Fixe Taxe errechnen 'Call usrCntlFaktAbrechnung.przPP(RG) ' Porto/Papiere errechnen 'Call usrCntlFaktAbrechnung.przBS415(RG) ' Bankspesen errechnen If RG.SAVE Then ' FAKTURIERT eintragen RECHNUNG = RG Return True Else Return False End If Catch ex As System.Exception MsgBox(ex.Message & ex.StackTrace) End Try Return False End Function Shared Function getGJ(BelegDat As Date, Optional FIRMA_ID As Integer = -1) As Integer 'If FIRMA = "" Then FIRMA = VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA Select Case FIRMA_ID Case -1, 1, 3, 11, 7, 19, 15 'Abweichendes WJ Return If(BelegDat.Month = 1, BelegDat.Year - 1, BelegDat.Year) Case Else Return BelegDat.Year End Select End Function Private Sub PictureBox6_Click(sender As Object, e As EventArgs) Handles PictureBox6.Click Dim webAddress As String = "https://wiki.verag.ag/abteilungen/mdm/parkplatz/abrechnungDauerparker" Process.Start(webAddress) End Sub End Class