Hallo Leute,
auch gegebenem Anlass möchte ich noch einmal dringend vor dem automatischen EB-Wertvotrag bei Sachkonten-OP warnen.
Suche den Fehler:
Das kann nicht passieren wenn man echte Einzelbuchungen vortragen würde.
Ich kann nur immer wieder dazu raten, auf die Option "Ausziffern EB-Wert mit Einzelbuchungen" zu verzichten und die EB-Werte in echte Einzelbuchungen vorzutragen.
Hierzu habe ich einmal ein VBSript-Tool vorgestellt.
Hier noch einmal mein Tool (eben getestet):
Es muss lediglich diese Zeile für den Exportpfad angepasst werden:
cTargetExportFile="L:\DATEV\DATEN\RWDAT\EXPORT\EB_Werte.csv"
Importiert werden die Buchungssätze über:
Und hier der Programmcode.
Einfach kopieren und als EB-Werte.vbs irgendwo abschpeichern.
Vorgehensweise:
Sachkonto-OP öffnen und als Excel exportieren. Danach das Tool per Doppelklick starten. Es können auch mehrere Konten hintereinander exportiert und per Tool bearbeitet werden. Anschließend die Buchungssätze importieren.
Bei Fragen einfach hier im Forum melden.
Option Explicit
Dim objExcel
Dim shtSource
Dim shtTarget
Dim iRow, q, iCol
Dim sValue(114) 'lt. Feldbeschreibung Buchungsstapel
Dim sTemp
On Error Resume Next
Set objExcel = GetObject(,"Excel.Application")
If err.number<>0 Then
Err.Clear
Set objExcel = CreateObject("Excel.Application")
End if
objExcel.Visible = True
'On Error Goto 0
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim cDatum
Dim cBelegfeld1
Dim cBelegfeld2
Dim cBuchungstext
Dim cUmsatzSoll
Dim cUmsatzHaben
Dim cKOST1
Dim EB_Datum
Dim sTmp
Dim GGKto, iLenKonto
Dim sKtoSplitter
'Pfade bitte anpassen
'muss nicht gelöscht werden, da beim Import in DATEV diese Datei gelöscht werden kann.
'Damit ist es jetzt möglich, mehrere Konten mit EB-Wert vorzutragen (s. ForAppending)
'If objFSO.FileExists("S:\EB_Werte.csv") then objfso.DeleteFile("S:\EB_Werte.csv")
Dim cTargetExportFile
cTargetExportFile="L:\DATEV\DATEN\RWDAT\EXPORT\EB_Werte.csv"
Set shtSource = objExcel.ActiveSheet
EB_Datum = InputBox( "Geben Sie bitte das EB-Datum in Form dd.mm.jjjj ein.","EB-Datum","01.01." & Year(Now()))
If EB_Datum="" then
'[....] Tu was wenn leer
Else
EB_Datum =FormatExt(Day(EB_Datum),1) & FormatExt(Month(EB_Datum),2)
If InStr(1,shtSource.cells(1,1),"Abschlusskonto",1)<>0 Then 'Export aus Abschluss
sKtoSplitter="Abschlusskonto"
ElseIf InStr(1,shtSource.cells(1,1),"Kontoblatt",1)<>0 Then 'Export aus Kontoblatt
sKtoSplitter="Kontoblatt"
ElseIf InStr(1,shtSource.cells(1,1),"Arbeitskonto",1)<>0 Then 'Export aus Arbeitskonto
sKtoSplitter="Arbeitskonto"
Else
MsgBox "Der Kontoexport konnte nicht erkannt werden. Es werden nur Arbeitskonto, normales Konto u. Abschlusskonto unterstützt.",vbCritical, "Exportfehler"
WScript.Quit
End If
'sTmp=Split(shtSource.cells(1,1),"Arbeitskonto",0,1)
sTmp = Split(shtSource.cells(1,1),sKtoSplitter,2,1) 'Auslesen des GGKto.
GGKto =GetEBKonto(sTmp(1)) 'letzte Trennung falls mehrere '-' vorhanden
iLenKonto = LenKonto(GGKto)
Const xlCellTypeLastCell=11
'Auslesen der Feldreihenfolge
For iCol=1 To shtSource.usedrange.specialcells(xlCellTypeLastCell).Column
Select Case shtSource.cells(2,iCol).Text
Case "Datum": cDatum=iCol
Case "Belegfeld1": cBelegfeld1=iCol
Case "Belegfeld2": cBelegfeld2=iCol
Case "Buchungstext": cBuchungstext=iCol
Case "Umsatz Soll": cUmsatzSoll=iCol
Case "Umsatz Haben": cUmsatzHaben=iCol
Case "KOST1": cKOST1=iCol
End Select
Next
Dim MyFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
If objFSO.FileExists(cTargetExportFile) = False then 'Pfade bitte anpassen
'Spaltenüberschriften
For iCol = 1 To 114
sTemp = sTemp & "Spalte " & iCol & ";"
Next
End If
Set MyFile = objFSO.OpenTextFile(cTargetExportFile, ForAppending, True) 'Pfade bitte anpassen
If Len(sTemp)>0 Then MyFile.Writeline sTemp
For iRow = 3 To shtSource.usedrange.specialcells(xlCellTypeLastCell).row
If shtSource.cells(iRow,cUmsatzSoll) <>"" Then
sValue(1) = shtSource.cells(iRow,cUmsatzSoll)
sValue(2)="H"
Else
sValue(1) = shtSource.cells(iRow,cUmsatzHaben)
sValue(2)="S"
End If
sValue(7) = "9" & String(iLenKonto-1, "0")
sValue(8) = Replace(GGKto," ","")
sValue(10) = EB_Datum
If Not IsEmpty(cBelegfeld1) Then sValue(11) = Trim(shtSource.cells(iRow,cBelegfeld1))
If Not IsEmpty(cBelegfeld2) Then sValue(12) = Trim(shtSource.cells(iRow,cBelegfeld2))
If Not IsEmpty(cBuchungstext) Then sValue(14) = Replace(Trim(shtSource.cells(iRow,cBuchungstext)),";",",")
If Not IsEmpty(cKOST1) Then sValue(37) = Trim(shtSource.cells(iRow,cKOST1))
sValue(114) = 0
sTemp=""
For q = 1 To 114
sTemp = sTemp & sValue(q) & ";"
Next
MyFile.Writeline sTemp
Next
MyFile.close
MsgBox "Fibu-Werte stehen zur Verfügung."
End if
'Hilfsfunktion
Function FormatExt(Zahl,Anzahl)
FormatExt= Right(String(Anzahl, "0") & zahl,Anzahl)
End Function
Function GetEBKonto(EBValue)
GetEBKonto = Trim(Mid(EBValue, 3, InStr(3, EBValue, " - ", vbTextCompare) - 3))
End Function
Function LenKonto(Konto)
If Len(konto) > 4 Then
LenKonto = 4 + Len(Right(Konto, Len(Konto) - InStr(1, Konto, " ", vbTextCompare)))
Else
LenKonto = 4
End If
End Function
Gruß Achilleus
