Makro
10.05.2016 08:27:50
Keller
ich möchte gerne von der Datei "Buchungsanweisung_Keller_KSt.xls" bestimmte Werte in eine andere Datei einspielen ("Schnittstelle.xls").
Dabei sollte die Schnittstellen - Datei automatisch geöffnet, dass Makro ausgeführt und anschließend die Schnittstellen - Datei gespeichert und geschlossen werden.
Das Makro schaut bislang wie folgt aus,
sind bestimmt lauter Fehler drin... momentan bringt er den Fehler:
"Fehler beim Kompilieren:
If-Block ohne End If" -> markiert dann die letzte Zeile des Makros
Sub Schnittstelle()
'Aus einer Eingabemaske heraus sollen die Steuerbuchungen in eine Schnittstellen-
'Datei übertragen werden.
'J. Keller 10.05.2016
Dim BelDat, Datei As String
Dim BKR, BelA, BuDat, Per, Wah, SKto, BWAS, HKto, BWAH, Zuo, Txt, Nachz, Erst
Dim zeileQ, zeileA, zeileZ
Dim wk As Worksheet
Dim wz As Workbook, wzT As Worksheet
'_____________________________________________________________________________________________________
'hier bitte innerhalb der Anführungszeichen die genaue Dateibezeichnung eintragen !!!!!
'Dabei ".xls" nicht vergessen !!
Application.ScreenUpdating = False
Datei = "C:\Users\kellerjo\Desktop\Buchungsbeleg NEU - Test - Kopie\Schnittstelle.xls"
'______________________________________________________________________________________________________
Set wk = ActiceSheet
Set wz = Workbooks.Open(Datei)
'nachfolgende Schleife springt von Zeile zu Zeile und überträgt die Daten,
'wenn ein Betrag eingetragen ist
'diese Schleife durchläuft den oberen Teil des Buchungsbeleges
For zeileQ = 12 To 20
BKR = wk.Cells(8, 2) 'Buchungskreis
BelDat = wk.Cells(8, 8) 'Belegdatum im Textformat
SKto = wk.Cells(zeileQ, 5) 'Soll-Konto
HKto = wk.Cells(zeileQ, 6) 'Haben-Konto
Nachz = wk.Cells(zeileQ, 3) 'Betrag Nachzahlung
Erst = wk.Cells(zeileQ, 4) 'Betrag Erstattung
Zuo = wk.Cells(zeileQ, 8) 'Zuordnung
Txt = wk.Cells(zeileQ, 2) 'Text
If SKto 1310000000 Then BWAS = wk.Cells(zeileQ, 7) Else BWAS = ""
If HKto 1310000000 Then BWAH = wk.Cells(zeileQ, 7) Else BWAH = ""
' eine Bewegungsart - Soll oder Haben - wird nur übernommen, wenn ein Sachkonto zwischen
' dem Wert 1310000000 und 1330000000 angegeben ist (d.h. ein RSt-Konto)
If Nachz + Erst "" Then
'wenn überhaupt kein Betrag eingetragen ist, erfolgt keine Übetragung an die SchnStelle
Workbooks("Schnittstelle.xls").Sheets("SchnSt").Activate 'Ansprechen der Schnittstellen- _
Datei
'nachfolgende Schleife sucht die erste freie Zeile auf dem Blatt Schnittstelle
zeileZ = wzT.Cells(Rows.Count, 2).End(xlUp).Row + 1
'ab hier werden die entsprechenden Werte eingetragen
wk.Cells(zeileZ, 2) = BKR
wk.Cells(zeileZ, 4) = BelDat
wk.Cells(zeileZ, 5) = "TS"
wk.Cells(zeileZ, 8) = "EUR"
wk.Cells(zeileZ, 9) = SKto
wk.Cells(zeileZ, 10) = BWAS
wk.Cells(zeileZ, 13) = HKto
wk.Cells(zeileZ, 14) = BWAH
wk.Cells(zeileZ, 17) = Nachz
If Nachz = 0 Or Nachz = "" And Erst 0 Then _
wk.Cells(zeileZ, 17) = Erst
wk.Cells(zeileZ, 18) = Zuo
wk.Cells(zeileZ, 19) = Txt
Workbooks("Buchungsanweisung_Keller_KSt.xls").Sheets("Beleg").Activate
'die Datei Buchungsanweisung wird wieder angesprochen;
For zeileA = 26 To 33
'diese Schleife durchläuft den unteren Teil des Buchungsbeleges
BKR = wk.Cells(8, 2) 'Buchungskreis
BelDat = wk.Cells(8, 8) 'Belegdatum im Textformat
SKto = wk.Cells(zeileA, 5) 'Soll-Konto
HKto = wk.Cells(zeileA, 6) 'Haben-Konto
Erst = wk.Cells(zeileA, 4) 'Betrag Erstattung
Zuo = wk.Cells(zeileA, 8) 'Zuordnung
Txt = wk.Cells(zeileA, 2) 'Text
If SKto 1310000000 Then BWAS = wk.Cells(zeileA, 7) Else BWAS = ""
If HKto 1310000000 Then BWAH = wk.Cells(zeileA, 7) Else BWAH = ""
' eine Bewegungsart - Soll oder Haben - wird nur übernommen, wenn ein Sachkonto zwischen
' dem Wert 1310000000 und 1330000000 angegeben ist (d.h. ein RSt-Konto)
If Nachz + Erst "" Then
'wenn überhaupt kein Betrag eingetragen ist, erfolgt keine Übetragung an die SchnStelle
Workbooks("Schnittstelle.xls").Sheets("SchnSt").Activate 'Ansprechen der Schnittstellen- _
Datei
'nachfolgende Schleife sucht die erste freie Zeile auf dem Blatt Schnittstelle
zeileZ = wzT.Cells(Rows.Count, 2).End(xlUp).Row + 1
'ab hier werden die entsprechenden Werte eingetragen
wk.Cells(zeileZ, 2) = BKR
wk.Cells(zeileZ, 4) = BelDat
wk.Cells(zeileZ, 5) = "TS"
wk.Cells(zeileZ, 8) = "EUR"
wk.Cells(zeileZ, 9) = SKto
wk.Cells(zeileZ, 10) = BWAS
wk.Cells(zeileZ, 13) = HKto
wk.Cells(zeileZ, 14) = BWAH
wk.Cells(zeileZ, 17) = Erst
wk.Cells(zeileZ, 18) = Zuo
wk.Cells(zeileZ, 19) = Txt
Workbooks("Buchungsanweisung_Keller_KSt.xls").Sheets("Beleg").Activate
'die Datei Buchungsanweisung wird wieder angesprochen;
End If
Next zeileA
wz.Close True
End Sub