Files
elwig-misc/wgmaster/vba/form/Form_MExportAuszahlung.frm

1371 lines
34 KiB
Plaintext

'Globals for data exchange with export functions
Dim mgnr1 As String
Dim nachname1 As String
Dim vorname1 As String
Dim strasse1 As String
Dim plz1 As String
Dim ort1 As String
Dim bhkontonr1 As String
Dim blz1 As String
Dim bankname1 As String
Dim bankname2 As String
Dim kontonr1 As String
Dim IBAN As String
Dim BIC As String
Dim netto1 As Double
Dim mwst1 As Double
Dim mwstprozent1 As Double
Dim brutto1 As Double
Dim sum_netto1 As Double
Dim sum_mwst1 As Double
Dim sum_brutto1 As Double
Dim noIBANorBIC As String
'Globals for bmd export
Dim Buchungsdatum1 As Date
Dim Gegenkonto1 As String
Dim Belegnummer1 As String
Dim Belegdatum1 As Date
Dim Kostenstelle1 As String
Dim Steuercode1 As String
Dim Buchungscode1 As String
Dim Zahlungsziel1 As String
Dim Skonto1 As String
Dim Skonto2 As String
Dim Vertreter1 As String
Dim Provision1 As String
Dim Benutzernummer1 As String
Dim Belegsymbol1 As String
Dim BruttoKonto As String
Dim NettoKonto As String
Dim MwStKonto As String
Private Sub BOk_Click()
If Fileexists(TExportDatei) Then
If MsgBox("Datei " + TExportDatei + " existiert bereits ! Überschreiben", vbYesNo) = vbYes Then
ExportAuszahlung TExportDatei, LAuszahlungsAnteil
'DoCmd.Close
End If
Else
If Not IsNull(TExportDatei) And TExportDatei <> "" Then
ExportAuszahlung TExportDatei, LAuszahlungsAnteil
'DoCmd.Close
Else
MsgBox "Bitte geben Sie eine Exportdatei an !", vbCritical
End If
End If
End Sub
Private Sub Form_Close()
If Not IsNull(TExportDatei) And TExportDatei <> "" Then
Select Case OExportOption
Case 1: ' CDF
SetParameter "AUSZAHLUNGEXPORTDATEI1", TExportDatei
Case 2: ' BMD: PERSONENKONTEN
SetParameter "AUSZAHLUNGEXPORTDATEI2", TExportDatei
Case 3: ' BMD: SACHKONTEN
SetParameter "AUSZAHLUNGEXPORTDATEI3", TExportDatei
Case 4: ' DBF
SetParameter "AUSZAHLUNGEXPORTDATEI4", TExportDatei
Case 5: ' DBF
SetParameter "AUSZAHLUNGEXPORTDATEI5", TExportDatei
End Select
End If
SetParameter "AUSZAHLUNGEXPORTDEFAULT", OExportOption
End Sub
Private Sub Form_Open(Cancel As Integer)
If IsNull(GetParameter("AUSZAHLUNGEXPORTDEFAULT")) Then
SetParameter "AUSZAHLUNGEXPORTDEFAULT", 1
End If
OExportOption = GetParameter("AUSZAHLUNGEXPORTDEFAULT")
Select Case OExportOption
Case 1: 'CDF
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1")
Case 2: 'BMD PERSONENKONTO
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2")
Case 3: 'BMD SACHKONTO
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3")
Case 4: 'DBF
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4")
Case 5: 'ELBA
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5")
End Select
LAuszahlungsAnteil = 0
End Sub
Sub ExportAuszahlung(filename1 As String, AuszahlungsAnteilModus As Long)
Dim db1 As Database
Dim rs_auszahlung As Recordset
Dim query1 As String
Dim Lesejahr1 As Long
Dim rcounter As Long
Dim line1 As String
Dim filenum
DoCmd.Hourglass True
Lesejahr1 = Forms!FAuszahlung!TLesejahr
query1 = "SELECT Nachname, Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, TMitglieder.IBAN, TMitglieder.BIC, Sum(TLieferungen.BTeilzahlung1) AS SBTeilzahlung1, Sum(TLieferungen.BTeilzahlung2) AS SBTeilzahlung2, Sum(TLieferungen.BTeilzahlung3) AS SBTeilzahlung3, Sum(TLieferungen.BTeilzahlung4) AS SBTeilzahlung4, Sum(TLieferungen.BTeilzahlung5) AS SBTeilzahlung5, Sum(TLieferungen.BEndauszahlung) AS SBEndauszahlung, Name1, Name2, TMitglieder.BLZ as BLZ, KontoNr, Sum(TLieferungen.BProbeauszahlung) AS SBProbeauszahlung, TMitglieder.Buchführend FROM TBanken RIGHT JOIN (TMitglieder INNER JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ "
query1 = query1 + "GROUP BY TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.MGNR, BHKontonummer, Name1, Name2, TMitglieder.BLZ, TMitglieder.KontoNr, TMitglieder.IBAN, TMitglieder.BIC, TMitglieder.Buchführend, Year([Datum]) HAVING (((Year([Datum]))=" + Format(Lesejahr1) + "))"
Set db1 = CurrentDb
Set rs_auszahlung = db1.OpenRecordset(query1)
rcounter = 0
sum_netto1 = 0
sum_mwst1 = 0
sum_brutto1 = 0
filenum = FreeFile
Open filename1 For Output As filenum
Select Case OExportOption
Case 1: ' CDF
PrintAuszahlungCDFHeader (filenum)
Case 2: ' BMD
PrintAuszahlungBMDHeader (filenum)
Case 3: ' BMD SAKO
PrintAuszahlungBMDSakoHeader (filenum)
Case 4: ' DBF
' the file access is not used
Close filenum
FileSystem.Kill (filename1)
PrintAuszahlungDBFHeader (filenum)
Open filename1 For Input As filenum
Case 5: ' CDF
PrintAuszahlungElbaHeader (filenum)
End Select
noIBANorBIC = ""
While Not rs_auszahlung.EOF
mgnr1 = Format(rs_auszahlung![MGNR])
If IsNull(rs_auszahlung!Nachname) Then nachname1 = "" Else nachname1 = rs_auszahlung!Nachname
If IsNull(rs_auszahlung!Vorname) Then vorname1 = "" Else vorname1 = rs_auszahlung!Vorname
If IsNull(rs_auszahlung![Straße]) Then strasse1 = "" Else strasse1 = rs_auszahlung![Straße]
If IsNull(rs_auszahlung![PLZ]) Then plz1 = "" Else plz1 = rs_auszahlung!PLZ
If IsNull(rs_auszahlung!Ort) Then ort1 = "" Else ort1 = rs_auszahlung!Ort
'If IsNull(rs_auszahlung!BLZ) Then blz1 = "" Else blz1 = rs_auszahlung!BLZ
'If IsNull(rs_auszahlung!KontoNr) Then kontonr1 = "" Else kontonr1 = rs_auszahlung!KontoNr
If IsNull(rs_auszahlung!BIC) Then
BIC = ""
noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", "
Else
BIC = rs_auszahlung!BIC
End If
If IsNull(rs_auszahlung!IBAN) Then
IBAN = ""
If Not IsNull(rs_auszahlung!BIC) Then
noIBANorBIC = noIBANorBIC + Format(rs_auszahlung!MGNR) + ", "
End If
Else
IBAN = rs_auszahlung!IBAN
End If
If IsNull(rs_auszahlung!BHKontonummer) Then bhkontonr1 = "" Else bhkontonr1 = rs_auszahlung!BHKontonummer
If IsNull(rs_auszahlung!Name1) Then bankname1 = "" Else bankname1 = rs_auszahlung!Name1
If IsNull(rs_auszahlung!Name2) Then bankname2 = "" Else bankname2 = rs_auszahlung!Name2
' calculate netto1
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: netto1 = rs_auszahlung!SBTeilzahlung1
Case 2: netto1 = rs_auszahlung!SBTeilzahlung2
Case 3: netto1 = rs_auszahlung!SBTeilzahlung3
Case 4: netto1 = rs_auszahlung!SBTeilzahlung4
Case 5: netto1 = rs_auszahlung!SBTeilzahlung5
Case 6: netto1 = rs_auszahlung!SBEndauszahlung - rs_auszahlung!SBTeilzahlung5 - rs_auszahlung!SBTeilzahlung4 - rs_auszahlung!SBTeilzahlung3 - rs_auszahlung!SBTeilzahlung2 - rs_auszahlung!SBTeilzahlung1
Case 7: netto1 = rs_auszahlung!SBProbeauszahlung
End Select
'Anteil % anwenden
Select Case AuszahlungsAnteilModus
Case 0: '100%
netto1 = Runden(netto1, 2)
Case 1: '50% Teilzahlung
netto1 = Runden(netto1 * 50 / 100, 2)
Case 2: '50% Restzahlung
netto1 = Runden(netto1, 2) - Runden(netto1 * 50 / 100, 2)
Case 3: '75% Teilzahlung
netto1 = Runden(netto1 * 75 / 100, 2)
Case 4: '25% Restzahlung
netto1 = Runden(netto1, 2) - Runden(netto1 * 75 / 100, 2)
End Select
'calculate mwst1
If rs_auszahlung![Buchführend] Then
mwstprozent1 = GetParameter("MWST2")
Else
mwstprozent1 = GetParameter("MWST1")
End If
mwst1 = Runden(netto1 * mwstprozent1 / 100, 2)
'mwst1 = netto1 * mwstprozent1 / 100
'calculate brutto1
brutto1 = netto1 + mwst1
'calculate sums
sum_brutto1 = sum_brutto1 + brutto1
sum_netto1 = sum_netto1 + netto1
sum_mwst1 = sum_mwst1 + mwst1
line1 = rs_auszahlung![MGNR]
' output to file
Select Case OExportOption
Case 1: ' CDF
PrintAuszahlungCDFData (filenum)
Case 2: ' BMD
PrintAuszahlungBMDData (filenum)
Case 3: ' BMD SAKO
PrintAuszahlungBMDSakoData (filenum)
Case 4: ' DBF
PrintAuszahlungDBFData (filenum)
Case 5: ' Elba
PrintAuszahlungElbaData (filenum)
End Select
rs_auszahlung.MoveNext
rcounter = rcounter + 1
Wend
rs_auszahlung.Close
DoCmd.Hourglass False
MsgBox (Format(rcounter) + " Auszahlungen erfolgreich exportiert ! Summe Netto: " + Format(sum_netto1) + " Summe MwSt: " + Format(sum_mwst1) + " Summe Brutto: " + Format(sum_brutto1))
If noIBANorBIC <> "" Then
MsgBox ("Folgende Mitglieder (MGNR) haben fehlende IBAN/BIC Daten:" + Chr(13) + Chr(10) + noIBANorBIC)
End If
Select Case OExportOption
Case 1: ' CDF
PrintAuszahlungCDFFooter (filenum)
Case 2: ' BMD
PrintAuszahlungBMDFooter (filenum)
Case 3: ' BMD
PrintAuszahlungBMDSakoFooter (filenum)
Case 4: ' DBF
PrintAuszahlungDBFFooter (filenum)
Case 5: ' Elba
PrintAuszahlungElbaFooter (filenum)
End Select
Close filenum
End Sub
Private Sub OExportOption_Click()
Select Case OExportOption
Case 1: 'CDF
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI1")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI1", "C:\AUSZAHLUNG.TXT"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI1")
Case 2: 'BMD
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI2")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI2", "C:\PEKO.BMD"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI2")
Case 3: 'BMD SACHKONTO
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI3")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI3", "C:\SAKO.BMD"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI3")
Case 4: 'DBF
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI4")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI4", "C:\AUSZAHLG.DBF"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI4")
Case 5: 'ELBA
If IsNull(GetParameter("AUSZAHLUNGEXPORTDATEI5")) Then
SetParameter "AUSZAHLUNGEXPORTDATEI5", "C:\AUSZAHLG.ELBA"
End If
TExportDatei = GetParameter("AUSZAHLUNGEXPORTDATEI5")
End Select
End Sub
' ******************************************************************************
' THE EXPORT ROUTINES
' ******************************************************************************
' ******************************************************************************
' CDF EXPORT
' ******************************************************************************
Sub PrintAuszahlungCDFData(filenumber)
Dim s1 As String
s1 = ";"
Print #filenumber, mgnr1 + s1 + nachname1 + s1 + vorname1 + s1 + strasse1 + s1 + plz1 + s1 + ort1 + s1 + IBAN + s1 + BIC + s1 + bankname1 + s1 + bankname2 + s1 + bhkontonr1 + s1 + Format(netto1, "#,##0.00") + s1 + Format(mwstprozent1) + s1 + Format(mwst1, "#,##0.00") + s1 + Format(brutto1, "#,##0.00")
End Sub
Sub PrintAuszahlungCDFHeader(filenumber)
Dim line1 As String
Dim s1 As String
s1 = ";"
line1 = ""
Print #filenumber, "AUSZAHLUNGSLISTE"
Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr)
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: Print #filenumber, "1. Teilzahlung"
Case 2: Print #filenumber, "2. Teilzahlung"
Case 3: Print #filenumber, "3. Teilzahlung"
Case 4: Print #filenumber, "4. Teilzahlung"
Case 5:
If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then
Print #filenumber, ""
Else
Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL")
End If
Case 6: Print #filenumber, "Endauszahlung"
Case 7: Print #filenumber, "Probeauszahlung"
End Select
Print #filenumber, Forms!FAuszahlung!TTitel
Print #filenumber, ""
Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "IBAN" + s1 + "BIC" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO"
End Sub
Sub PrintAuszahlungCDFFooter(filenumber)
End Sub
' ******************************************************************************
' BMD EXPORT: PERSONENKONTEN
' ******************************************************************************
Sub PrintAuszahlungBMDData(filenumber)
Dim line1 As String
Dim str1 As String
line1 = ""
str1 = ""
'bhkontonr
str1 = FillUp(bhkontonr1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1
'MsgBox (str1)
'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1
'MsgBox (str1)
'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1
'MsgBox (str1)
'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'buchungscode
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'buchungsbetrag
str1 = Format(brutto1 * 100, "00000000000")
If Buchungscode1 = "1" Then
str1 = str1 + "+"
Else
str1 = str1 + "-"
End If
line1 = line1 + str1
'MsgBox (str1)
'steuerbetrag
'str1 = Format(mwst1 * 100, "00000000000")
'If Buchungscode1 = "1" Then
' str1 = str1 + "+"
'Else
' str1 = str1 + "-"
'End If
str1 = "00000000000-"
line1 = line1 + str1
'MsgBox (str1)
'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
'str1 = FillUp(nachname1 + " " + vorname1, 12, 0, " ")
line1 = line1 + str1
'MsgBox (str1)
'zahlungsziel
str1 = FillUp(Zahlungsziel1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'skonto %
str1 = FillUp(Skonto1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'skonto tage
str1 = FillUp(Skonto2, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'Vertreter Nr
str1 = FillUp(Vertreter1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'provision
str1 = FillUp(Provision1, 3, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1
'MsgBox (str1)
'platzhalter " "
str1 = " "
line1 = line1 + str1
'MsgBox (str1)
'sperrcode
str1 = "0"
line1 = line1 + str1
'MsgBox (str1)
'stern
str1 = "*"
line1 = line1 + str1
'MsgBox (str1)
Print #filenumber, line1
End Sub
Sub PrintAuszahlungBMDHeader(filenumber)
Dim zahlungszieldatum As Date
Dim zahlungszieltage As Integer
'DoCmd.OpenForm
Do
Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy"))
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
End If
Loop While IsNull(Buchungsdatum1)
Do
Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
End If
Loop While IsNull(Belegdatum1)
Do
zahlungszieldatum = InputBox("Zahlungsziel: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
End If
Loop While IsNull(zahlungszieldatum)
zahlungszieltage = zahlungszieldatum - Buchungsdatum1
Zahlungsziel1 = Format(zahlungszieltage)
Kostenstelle1 = "000000"
Gegenkonto1 = "000000"
Belegnummer1 = "000000"
Steuercode1 = "0"
Buchungscode1 = "2"
Skonto1 = "000"
Skonto2 = "000"
Vertreter1 = "001"
Provision1 = "000"
Benutzernummer1 = "1"
Belegsymbol1 = "AG"
DoCmd.Hourglass True
End Sub
Sub PrintAuszahlungBMDFooter(filenumber)
If MsgBox("Wollen Sie auch die Mitgliederstammdaten exportieren ?", vbYesNo) = vbYes Then
DoCmd.OpenForm "MExportMitglieder"
End If
End Sub
' ******************************************************************************
' BMD EXPORT: SACHKONTEN
' ******************************************************************************
Sub PrintAuszahlungBMDSakoData(filenumber)
End Sub
Sub PrintAuszahlungBMDSakoHeader(filenumber)
Dim zahlungszieldatum As Date
Dim zahlungszieltage As Integer
'DoCmd.OpenForm
Do
BruttoKonto = InputBox("Sachkonto Brutto: ", , "003310")
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
End If
Loop While IsNull(BruttoKonto)
Do
NettoKonto = InputBox("Sachkonto Netto: ", , "005100")
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
End If
Loop While IsNull(NettoKonto)
Do
MwStKonto = InputBox("Sachkonto MwSt: ", , "002510")
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie eine gültige Buchhaltungs-Kontonummer ein !"
End If
Loop While IsNull(MwStKonto)
Do
Buchungsdatum1 = InputBox("Buchungsdatum: ", , Format(Date, "dd.mm.yyyy"))
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
End If
Loop While IsNull(Buchungsdatum1)
Do
Belegdatum1 = InputBox("Belegdatum: ", , Format(Buchungsdatum1, "dd.mm.yyyy"))
If IsNull(Buchungsdatum1) Then
MsgBox "Bitte geben Sie ein gültiges Datum im Format TT.MM.JJJJ ein", vbCritical, "UNGÜLTIGE EINGABE"
End If
Loop While IsNull(Belegdatum1)
Kostenstelle1 = "000000"
Gegenkonto1 = "000000"
Belegnummer1 = "000000"
Steuercode1 = "0"
Benutzernummer1 = "1"
Belegsymbol1 = " "
mwstprozent1 = 0
DoCmd.Hourglass True
End Sub
Sub PrintAuszahlungBMDSakoFooter(filenumber)
Dim line1 As String
Dim str1 As String
' 1. Bruttobuchung
' ================
line1 = ""
str1 = ""
mwstprozent1 = 0
'bhkontonr
str1 = FillUp(BruttoKonto, 6, 1, "0")
line1 = line1 + str1
'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1
'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1
'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1
'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1
'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1
'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1
'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1
'buchungscode
Buchungscode1 = "2"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1
'buchungsbetrag
str1 = Format(sum_brutto1 * 100, "00000000000")
str1 = str1 + "-"
line1 = line1 + str1
'steuerbetrag
str1 = "00000000000-"
line1 = line1 + str1
'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1
'platzhalter: 0
str1 = "0"
line1 = line1 + str1
'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1
'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1
'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1
'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1
'platzhalter " "
str1 = " "
line1 = line1 + str1
'sperrcode
str1 = "0"
line1 = line1 + str1
'stern
str1 = "*"
line1 = line1 + str1
Print #filenumber, line1
' 2. Nettobuchung
' ================
line1 = ""
str1 = ""
'bhkontonr
str1 = FillUp(NettoKonto, 6, 1, "0")
line1 = line1 + str1
'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1
'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1
'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1
'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1
'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1
'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1
'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1
'buchungscode
Buchungscode1 = "1"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1
'buchungsbetrag
str1 = Format(sum_netto1 * 100, "00000000000")
str1 = str1 + "+"
line1 = line1 + str1
'steuerbetrag
str1 = "00000000000+"
line1 = line1 + str1
'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1
'platzhalter: 0
str1 = "0"
line1 = line1 + str1
'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1
'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1
'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1
'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1
'platzhalter " "
str1 = " "
line1 = line1 + str1
'sperrcode
str1 = "0"
line1 = line1 + str1
'stern
str1 = "*"
line1 = line1 + str1
Print #filenumber, line1
' 3. MwStbuchung
' ================
line1 = ""
str1 = ""
'bhkontonr
str1 = FillUp(MwStKonto, 6, 1, "0")
line1 = line1 + str1
'buchungsdatum
str1 = Format(year(Buchungsdatum1) - 2000, "00") + Format(Month(Buchungsdatum1), "00") + Format(Day(Buchungsdatum1), "00")
line1 = line1 + str1
'gegenkonto
str1 = FillUp(Gegenkonto1, 6, 1, "0")
line1 = line1 + str1
'belegnummer
str1 = FillUp(Belegnummer1, 6, 1, "0")
line1 = line1 + str1
'belegdatum
str1 = Format(year(Belegdatum1) - 2000, "00") + Format(Month(Belegdatum1), "00") + Format(Day(Belegdatum1), "00")
line1 = line1 + str1
'kostenstelle
str1 = FillUp(Kostenstelle1, 6, 1, "0")
line1 = line1 + str1
'mwstprozent
str1 = Format(mwstprozent1, "00")
line1 = line1 + str1
'steuercode
str1 = FillUp(Steuercode1, 1, 1, "0")
line1 = line1 + str1
'buchungscode
Buchungscode1 = "1"
str1 = FillUp(Buchungscode1, 1, 1, "0")
line1 = line1 + str1
'buchungsbetrag
str1 = Format(sum_mwst1 * 100, "00000000000")
str1 = str1 + "+"
line1 = line1 + str1
'steuerbetrag
str1 = "00000000000+"
line1 = line1 + str1
'buchungstext
Select Case Forms!FAuszahlung!TZahlungNr
Case 1: str1 = "1.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 2: str1 = "2.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 3: str1 = "3.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 4: str1 = "4.TEILZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 5: str1 = Left(GetParameter("FREIERAUSZAHLUNGSTITEL"), 7) + " " + Format(Forms!FAuszahlung!TLesejahr)
Case 6: str1 = "ENDAUSZ " + Format(Forms!FAuszahlung!TLesejahr)
Case 7: str1 = "PROBEZ " + Format(Forms!FAuszahlung!TLesejahr)
End Select
str1 = FillUp(str1, 18, 0, " ")
line1 = line1 + str1
'platzhalter: 0
str1 = "0"
line1 = line1 + str1
'buchungsmonat: 00
str1 = "00"
line1 = line1 + str1
'platzhalter: 000000
str1 = "000000"
line1 = line1 + str1
'benutzernummer
str1 = FillUp(Benutzernummer1, 1, 1, "0")
line1 = line1 + str1
'Belegsymbol
str1 = FillUp(Belegsymbol1, 2, 1, "0")
line1 = line1 + str1
'platzhalter " "
str1 = " "
line1 = line1 + str1
'sperrcode
str1 = "0"
line1 = line1 + str1
'stern
str1 = "*"
line1 = line1 + str1
Print #filenumber, line1
End Sub
' ******************************************************************************
' DBF EXPORT
' ******************************************************************************
Sub PrintAuszahlungDBFData(filenumber)
' Do nothing
End Sub
Sub PrintAuszahlungDBFHeader(filenumber)
Dim SEL1 As String
Dim GROUP1 As String
Dim where1 As String
Dim order1 As String
Dim query1
Dim savepath1
Dim temptablename1
SEL1 = "SELECT DISTINCT TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße as STRASSE, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1 AS Bank, TMitglieder.BHKontonummer AS BHKONTO, CCur(Sum(IIf([Formulare]![FAuszahlung]![TZahlungNr]=1,[BTeilzahlung1],IIf([Formulare]![FAuszahlung]![TZahlungNr]=2,[BTeilzahlung2],IIf([Formulare]![FAuszahlung]![TZahlungNr]=3,[BTeilzahlung3],IIf([Formulare]![FAuszahlung]![TZahlungNr]=4,[BTeilzahlung4],IIf([Formulare]![FAuszahlung]![TZahlungNr]=5,[BTeilzahlung5],IIf([Formulare]![FAuszahlung]![TZahlungNr]=6,[BEndauszahlung]-[BTeilzahlung4]-[BTeilzahlung3]-[BTeilzahlung2]-[BTeilzahlung1],[BProbeauszahlung])))))))) AS NETTO, First(IIf([Buchführend],Getparameter('MWST2'),GetPArameter('MWST1'))) AS MWSTPROZ, Runden(NETTO*MWSTPROZ/100,2) as MWST, Runden(NETTO*(MWSTPROZ+100)/100,2) as BRUTTO"
SEL1 = SEL1 + " FROM TBanken RIGHT JOIN (TMitglieder RIGHT JOIN TLieferungen ON TMitglieder.MGNR = TLieferungen.MGNR) ON TBanken.BLZ = TMitglieder.BLZ "
GROUP1 = " GROUP BY TMitglieder.MGNR, TMitglieder.Nachname, TMitglieder.Vorname, TMitglieder.Straße, TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.KontoNr, TMitglieder.BLZ, TBanken.Name1, TMitglieder.BHKontonummer "
Select Case OSortierung
Case 1: order1 = " ORDER BY TMitglieder.MGNR "
Case 2: order1 = " ORDER BY TMitglieder.PLZ, TMitglieder.Ort, TMitglieder.Nachname, TMitglieder.Vorname "
End Select
where1 = " WHERE Year(Datum)=" + Format(Forms!FAuszahlung!TLesejahr) + " AND Storniert=false "
If Not IsNull(Forms!FAuszahlung!TZNR) And Forms!FAuszahlung!TZNR <> "" Then
where1 = where1 + " AND TLieferungen.ZNR=" + Format(Forms!FAuszahlung!TZNR)
End If
If Not IsNull(Forms!FAuszahlung!TVon) And Forms!FAuszahlung!TVon >= 0 Then
If OSortierung = 1 Then
where1 = where1 + " AND TLieferungen.MGNR>=" + Format(Forms!FAuszahlung!TVon) + " "
Else
where1 = where1 + " AND TMitglieder.PLZ>=" + Format(Forms!FAuszahlung!TVon) + " "
End If
End If
If Not IsNull(Forms!FAuszahlung!TBis) And Forms!FAuszahlung!TBis >= 0 Then
If OSortierung = 1 Then
where1 = where1 + " AND TLieferungen.MGNR<=" + Format(Forms!FAuszahlung!TBis) + " "
Else
where1 = where1 + " AND TMitglieder.PLZ<=" + Format(Forms!FAuszahlung!TBis) + " "
End If
End If
query1 = SEL1 + where1 + GROUP1 + order1
'savepath1 = InputBox("Excel Datei speichern unter:", "EXCEL DATEI EXPORTIEREN", "C:\Eigene Dateien\auszahlung.xls")
'If IsNull(savepath) Or savepath1 = "" Then
' Exit Sub
'End If
DoCmd.Hourglass True
queryname1 = "AAuszahlungExport"
temptablename1 = "xTempAuszahlungExport"
Dim db1 As Database
Set db1 = CurrentDb
'On Error Resume Next
If QueryExists(queryname1) = True Then
DoCmd.DeleteObject acQuery, queryname1
End If
db1.CreateQueryDef queryname1, query1
db1.Close
'DoCmd.TransferSpreadsheet acExport, 0, queryname1, TExportDatei, True
DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei)
'use table instead of query
Dim rs1 As Recordset
Set db1 = CurrentDb
If TableExists(temptablename1) Then
db1.Execute ("DROP TABLE " + temptablename1)
End If
'db1.Execute ("CREATE TABLE xTempAuszahlungExport (MGNR LONG, Nachname TEXT, Vorname TEXT, STRASSE TEXT, PLZ TEXT, Ort TEXT, KontoNr TEXT,BLZ TEXT, Bank TEXT, BHKONTO TEXT, NETTO DOUBLE, MWSTPROZ DOUBLE, MWST DOUBLE, BRUTTO DOUBLE);")
'reimport file for AnteilAuszahlung
DoCmd.TransferDatabase acImport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, GetFilenameFromFullName(TExportDatei), temptablename1
Set rs1 = db1.OpenRecordset(temptablename1)
While Not rs1.EOF
rs1.Edit
'Anteil % anwenden
Select Case LAuszahlungsAnteil
Case 0: '100%
'rs1!Netto keeps unchanged
Case 1: '50% Teilzahlung
rs1!Netto = Runden(rs1!Netto * 50 / 100, 2)
Case 2: '50% Restzahlung
rs1!Netto = rs1!Netto - Runden(rs1!Netto * 50 / 100, 2)
End Select
rs1!mwst = Runden(rs1!Netto * rs1!mwstproz / 100, 2)
rs1!Brutto = Runden(rs1!Netto * (100 + rs1!mwstproz) / 100, 2)
rs1.Update
rs1.MoveNext
Wend
rs1.Close
'DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acTable, temptablename1, GetFilenameFromFullName(TExportDatei)
If QueryExists(queryname1) = True Then
DoCmd.DeleteObject acQuery, queryname1
End If
db1.CreateQueryDef queryname1, "SELECT * FROM " + temptablename1 + " ORDER BY MGNR"
DoCmd.TransferDatabase acExport, "DBASE IV", GetPathFromFullName(TExportDatei), acQuery, queryname1, GetFilenameFromFullName(TExportDatei)
End Sub
Sub PrintAuszahlungDBFFooter(filenumber)
' Do nothing
End Sub
' ******************************************************************************
' ELBA EXPORT
' ******************************************************************************
Sub PrintAuszahlungElbaData(filenumber)
Dim s1 As String
s1 = Chr(9)
'CP 04.07.2007: Nur Werte >0 exportieren
If brutto1 > 0 Then
Print #filenumber, Format(brutto1, "0.00") + s1 + BIC + s1 + IBAN + s1 + nachname1 + " " + vorname1 + s1 + plz1 + " " + ort1
End If
End Sub
Sub PrintAuszahlungElbaHeader(filenumber)
Dim line1 As String
Dim s1 As String
s1 = Chr(9)
line1 = ""
'Print #filenumber, "AUSZAHLUNGSLISTE"
'Print #filenumber, "für Lesejahr " + Format(Forms!FAuszahlung!TLesejahr)
'Select Case Forms!FAuszahlung!TZahlungNr
' Case 1: Print #filenumber, "1. Teilzahlung"
' Case 2: Print #filenumber, "2. Teilzahlung"
' Case 3: Print #filenumber, "3. Teilzahlung"
' Case 4: Print #filenumber, "4. Teilzahlung"
' Case 5:
' If IsNull(GetParameter("FREIERAUSZAHLUNGSTITEL")) Then
' Print #filenumber, ""
' Else
' Print #filenumber, GetParameter("FREIERAUSZAHLUNGSTITEL")
' End If
' Case 6: Print #filenumber, "Endauszahlung"
' Case 7: Print #filenumber, "Probeauszahlung"
'End Select
'Print #filenumber, Forms!FAuszahlung!TTitel
'Print #filenumber, ""
'Print #filenumber, "MITGLIEDSNUMMER" + s1 + "NACHNAME" + s1 + "VORNAME" + s1 + "STRASSE" + s1 + "PLZ" + s1 + "ORT" + s1 + "KONTONUMMER" + s1 + "BLZ" + s1 + "BANKNAME1" + s1 + "BANKNAME2" + s1 + "BHKONTONUMMER" + s1 + "NETTO" + s1 + "MWST PROZENT " + s1 + "MWST" + s1 + "BRUTTO"
End Sub
Sub PrintAuszahlungElbaFooter(filenumber)
End Sub
' ******************************************************************************
' MISC FUNCTIONS
' ******************************************************************************
Function QueryExists(query1) As Boolean
Dim db1 As Database
Set db1 = CurrentDb
Dim x As QueryDef
For Each x In db1.QueryDefs
If x.Name = query1 Then
'MsgBox (X.Name)
QueryExists = True
Exit Function
End If
Next x
QueryExists = False
End Function
Function TableExists(table1) As Boolean
Dim db1 As Database
Set db1 = CurrentDb
Dim x As TableDef
For Each x In db1.TableDefs
If x.Name = table1 Then
TableExists = True
Exit Function
End If
Next x
TableExists = False
End Function
Function GetPathFromFullName(fullname As String) As String
Dim i
Dim path1
i = Len(fullname)
While i > 1 And Mid(fullname, i, 1) <> "\"
i = i - 1
Wend
If i = 1 Then
path1 = "C:\"
Else
path1 = Left(fullname, i - 1)
End If
'MsgBox (path1)
If InStr(path1, "\") = 0 Then
path1 = path1 + "\"
End If
GetPathFromFullName = path1
End Function
Function GetFilenameFromFullName(fullname As String) As String
Dim i
Dim filename1
i = Len(fullname)
While i > 1 And Mid(fullname, i, 1) <> "\"
i = i - 1
Wend
If i > 1 Then i = i + 1
filename1 = Mid(fullname, i)
'MsgBox (filename1)
GetFilenameFromFullName = filename1
End Function
Function FillUp(text1 As String, laenge1 As Long, left1 As Long, fillchar1 As String) As String
Dim str1 As String
str1 = text1
If Len(str1) > laenge1 Then
' it is too long
str1 = Left(str1, laenge1)
End If
While (Len(str1) < laenge1)
' it is still too short
If left1 Then
str1 = fillchar1 + str1
Else
str1 = str1 + fillchar1
End If
Wend
FillUp = str1
End Function
Function Fileexists(filename As String) As Boolean
On Error GoTo NoFile
If FileSystem.GetAttr(filename) >= 0 Then
Fileexists = True
Else
Fileexists = False
End If
Exit Function
NoFile:
Fileexists = False
Exit Function
End Function
Public Function Runden(value1 As Double, digits As Integer) As Double
Dim temp1 As Double
temp1 = value1 * (10 ^ digits)
If (temp1 * 10) Mod 10 = 5 Then
temp1 = temp1 + 1
temp1 = Fix(temp1)
temp1 = temp1 / (10 ^ digits)
Runden = temp1
Else
Runden = CLng(value1 * (10 ^ digits)) / (10 ^ digits)
End If
End Function