Ich habe für die Baulohn Kalendarium Excel Datei von Datev per vba eine importfähige Datei für LODAS programmiert bzw. im das Makro wird nicht in der Datei gespeichert sondern im persönlichen Makro Verzeichnis vom Bearbeiter.
Der Mandant muss uns nur wie üblich die Excel Datei schicken (Keine Änderung). Pro Reiter ein Arbeitnehmer.
Es gibt ein paar Einschränkungen (Feiertage, Krankheit müssen manuell eingetippt werden), aber die Bearbeitungszeit hat sich deutlich verringert.
Ich konnte einfach nicht mehr zu sehen wie ein Kollege, die Excel Dateien ausdruckt und abtippt.
(Selbststudium in der Freizeit, Schnittstellen-Handbuch angesehen etc.)
Falls jemand Interesse hat, kann ich den Quellcode hier posten.
LODAS Baulohn Kalendarium Tool
Ich übernehme keine Verantwortung/Haftung für irgendwelche Schäden. Das Tool ist von mir getestet und es traten bei mir vereinzelt Probleme auf. Anspruch auf Support besteht nicht. Bin aber gerne bereit zu helfen.
Ich bin kein Profi. Ich habe mich in der Freizeit mit vba beschäftigt und dieses Tool entwickelt.
Es gibt sicherlich eine bessere Vorgehensweise bzw. besseren Code. Es ist sicherlich auch unnötiger Code enthalten.
Falls der Reiter fehlt unter Optionen - Menüband anpassen einblenden
Der Code wird in PERSONAL.XLSB gespeichert. Falls der Bereich nicht ersichtlich ist, kann per Makro aufzeichnen - Makro speichern in "Persönliche Makroarbeitsmappe" der Bereich geschaffen werden.
Neues Modul erstellen, CODE einfügen und speichern.
Bei der Datei des Mandanten waren keine Pers.Nr eingetragen. Das Tool sucht aus einer ANListe Datei die Namen und die dazugehörigen Nummern.
Falls das nicht benötigt wird die folgenden Codes löschen
"przPersNrAusTabelleEintragen 'Aus ANListe Excel-Datei"
"przPersNrInTabelleSpeichern 'Änderungen durch Ergänzungen werden in die ANListe Excel-Datei gespeichert"
Die Beraternummer und die Mandantennummer müssen geändert werden.
Die Excel Datei des Mandanten wird geöffnet. (Baulohn Kalendarium von Datev)
Über Entwicklertools - Makros - kann das entsprechende Makro ausgeführt werden.
Die Importfähige Datei wird im gleichen Ordner gespeichert und kann dann in Lodas über ASCII importiert werden.
Viel Erfolg.
_______________________________________________________________________________________________________________
Option Explicit
Sub LodasBaulohnImport()
'Makro Datum: 08.04.2021
'Fehlende Funktionen/Hinweise
'-
'- Einträge mit Schlüssel U/F/FE etc. werden absichtlich nicht übernommen - Manuelles Eintippen in Lodas notwendig!
'- Übernahme Bereich von Std, Schlüssel und Baustelle von B8 bis AF19 - 4xBlöcke pro Tag - Manuell eingefügte Zeilen werden nicht übernommen
'-
Dim wkbMappe As Workbook
Dim wksBlatt As Worksheet
Dim WkSEnde As Long
Dim intBlatt As Integer
Dim lngSpalte As Long
Dim lngSpalteMax As Long
Dim lngZeile As Long
Dim SngStd1 As Single
Dim strStd1 As String
Dim strSchluessel1 As String
Dim intBaustelle1 As String
Dim strArbName As String
Dim strBeraternummer As String
Dim strMandantennummer As String
Dim strErfassung As String
Dim wsBewegungsdaten As Worksheet
Dim wsStammdaten As Worksheet
Dim strTag As String
Dim strMonat As String
Dim strMonatHeute As String
Dim strMonatDifferenz As String
Dim strJahr As String
Dim Datum As String
Dim intWoche As Integer
Dim Wochentag As String
Dim imput As Variant
Dim lngZeileU As Long
Dim Leerzeile As String
Dim strDatensatz As String
Dim intPNr As Integer
Dim strPreFix As String
Const STRTZ = ";"
Const STRSB = "'"
Const STRSATZART = "6"
strBeraternummer = "1" 'BERATERNUMMER ÄNDERN
strMandantennummer = "11111" 'MANDANTENNUMMER ÄNDERN
przPersNrAusTabelleEintragen 'Aus ANListe Excel-Datei
' On Error GoTo Fehler
Set wsBewegungsdaten = ActiveWorkbook.ActiveSheet
Set wkbMappe = ActiveWorkbook
Set wksBlatt = wkbMappe.Worksheets(2)
With wkbMappe.ActiveSheet
strMonat = Format(.cells(3, "U").Value, "MM")
strJahr = Format(.cells(3, "U").Value, "YYYY")
If wkbMappe.Worksheets(2).cells(3, "O").Value = "" Then 'Fehlt die erste Personalnummer?
MsgBox "Erste Pers.-Nr. fehlt"
Else
Application.DisplayAlerts = False
Application.ScreenUpdating = False
intPNr = .cells(3, "O").Value
Open ActiveWorkbook.Path & "\" & "Lodas_Import_" & strBeraternummer & "_" & strMandantennummer & "_" & strMonat & "." & strJahr & ".txt" For Output As #1
Print #1, "[Allgemein]" 'muss
Print #1, "Ziel = Lodas" 'muss
Print #1, "Version Excel-Baulohnexport 08.04.2021" 'kann
Print #1, "BeraterNr = " & strBeraternummer 'muss
Print #1, "MandantenNr = " & strMandantennummer 'muss
Print #1, "Feldtrennzeichen=" & STRTZ 'kann
Print #1, "Zahlenkomma=," 'kann
Print #1, "Datumsformat=TT.MM.JJJJ" 'kann
Print #1, "Stringbegrenzer='" 'kann
Print #1, "Kommentarzeichen=*" 'kann
Print #1, "StammdatenGueltigAb=01." & strMonat & "." & strJahr
Print #1, Leerzeile
' Bemerkungen von Sheet Bemerkungen
For lngZeileU = 9 To 33
Print #1, ""
Next lngZeileU
Print #1, Leerzeile
Print #1, "[Satzbeschreibung]"
Print #1, "6;u_lod_bwd_buchung_kalendarium;pnr#bwd;abrechnung_zeitraum#bwd;kalendertag#bwd;kalenderwoche#bwd;wochentag#kal;stunden_pro_tag#bwd;as_kal#bwd;kostenstelle#bwd;la_eigene#bwd;"
Print #1, Leerzeile
'Bewegungsdaten (Satzart = 22)
Print #1, "[Bewegungsdaten]"
lngSpalteMax = 32
WkSEnde = wkbMappe.Worksheets.Count
'
For intBlatt = 2 To WkSEnde ' Alle Arbeitblätter nacheinander durchgehen
wkbMappe.Worksheets(intBlatt).Select
If wkbMappe.Worksheets(intBlatt).cells(3, "B").Value <> "ARBEITNEHMER1" Then 'Arbeitsblaetter mit diesen Namen ueberspringen
If wkbMappe.Worksheets(intBlatt).cells(3, "B").Value <> "ARBEITNEHMER2" Then
strArbName = wkbMappe.Worksheets(intBlatt).cells(3, 2).Value
strMonat = Format(wkbMappe.Worksheets(intBlatt).cells(3, "U").Value, "MM")
strJahr = Format(wkbMappe.Worksheets(intBlatt).cells(3, "U").Value, "YYYY")
strMonatHeute = Format(Date, "MM")
strMonatDifferenz = strMonatHeute - strMonat
'Pruefung ob laenger als 1 Monat her? Z.B. Heute April, Abrechnungsmonat: Maerz, Eintrag: Februar -> Arbeitsblatt wird uebersprungen
If strMonatDifferenz > 1 Then
' Exit For
MsgBox "Länger als 1 Monat her." & Chr(10) & "Diese Daten sind vermutlich für eine Nachberechnung" & Chr(10) & _
"Das Arbeitblatt wieder übersprungen!" & Chr(10) & " PersNr. " & intPNr & " PersName: " & strArbName & " Monat: " & strMonat, vbCritical
intBlatt = intBlatt + 1
wkbMappe.Worksheets(intBlatt).Select
strMonat = Format(wkbMappe.Worksheets(intBlatt).cells(3, "U").Value, "MM")
strJahr = Format(wkbMappe.Worksheets(intBlatt).cells(3, "U").Value, "YYYY")
Else
End If
' Suchen und Ersetzen
On Error GoTo Fehler:
'Bindestrich und Absatz entfernen
wkbMappe.Worksheets(intBlatt).cells.SpecialCells(xlCellTypeConstants).Replace _
what:="-" & Chr(10), Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
'Absatz entfernen (ohne Bindestrich)
wkbMappe.Worksheets(intBlatt).cells.SpecialCells(xlCellTypeConstants).Replace _
what:=Chr(10), Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
' Leerstelle entfernen
' wkbMappe.Worksheets(intBlatt).cells.SpecialCells(xlCellTypeConstants).Replace _
' what:=Chr(32), Replacement:="", lookat:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False
Range("B6").Select
If wkbMappe.Worksheets(intBlatt).cells(3, "O").Value <> "" Then 'Pruefung Pers.Nr eingegeben?
intPNr = wkbMappe.Worksheets(intBlatt).cells(3, "O").Value
Else
intPNr = InputBox("Wie lautet die PersNr. von " & strArbName & "?")
wkbMappe.Worksheets(intBlatt).cells(3, "O").Value = intPNr
End If
For lngSpalte = 2 To lngSpalteMax
strTag = wkbMappe.Worksheets(intBlatt).cells(6, lngSpalte)
strTag = Format(strTag, "00")
For lngZeile = 8 To 19
'STUNDEN
If wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value <> "" Then
SngStd1 = wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value
strStd1 = wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value
If Len(strStd1) > 5 Then
MsgBox "Fehler in Stundenanzahl! Mehr als 5 Zeichen." & Chr(10) & _
"Das Programm geht trotzdem weiter und speichert die Zeichen in der Textdatei." _
& Chr(10) & " PersNr. " & intPNr & " PersName: " & strArbName & " Tag: " & strTag & _
Chr(10) & " Inhalt: " & SngStd1, vbCritical
' Exit For
Else
End If
Else
Exit For
End If
lngZeile = lngZeile + 1
'SCHLUESSEL
If wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value <> "" Then
strSchluessel1 = wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value
If Len(strSchluessel1) > 2 Then
MsgBox "Schlüssel zu lang! Mehr als 2 Zeichen." & Chr(10) & _
Chr(10) & "Das Programm geht trotzdem weiter und speichert die Zeichen in der Textdatei." & _
Chr(10) & " PersNr. " & intPNr & " PersName: " & strArbName & " Tag: " & strTag & Chr(10) & " Inhalt: " & _
strSchluessel1, vbCritical
' Exit For
Else
End If
Else
Exit For
End If
lngZeile = lngZeile + 1
'BAUSTELLE
If wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value <> "" Then
intBaustelle1 = wkbMappe.Worksheets(intBlatt).cells(lngZeile, lngSpalte).Value
Else
Exit For
End If
'Wenn keine Stunden eingegeben wird nicht hinzugefügt
Datum = strTag & "." & strMonat
intWoche = Format(Datum, "ww", vbMonday, vbFirstFourDays)
If intWoche > 52 Then
If Format(Datum + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then intWoche = 1
End If
Wochentag = Format(Datum, "DDD")
'20;u_lod_bwd_buchung_kalendarium;pnr#bwd;abrechnung_zeitraum#bwd;kalendertag#bwd;kalenderwoche#
'bwd;wochentag#kal;stunden_pro_tag#bwd;as_kal#bwd;kostenstelle#bwd;la_eigene#bwd;"
With wsBewegungsdaten
strDatensatz = STRSATZART & STRTZ & intPNr & STRTZ & "01." & strMonat & "." & strJahr _
& STRTZ & strTag & STRTZ & intWoche & STRTZ & Wochentag _
& STRTZ & SngStd1 & STRTZ & strSchluessel1 & STRTZ & intBaustelle1 & STRTZ & "201" & STRTZ
End With
Print #1, strDatensatz
Next lngZeile
Next lngSpalte
End If
End If
' Columns("B:AF").Select
' Selection.ColumnWidth = 4.5 'spaltebreite erhöhen, damit die Auftragsnummer angezeigt wird
Next intBlatt
przPersNrInTabelleSpeichern 'Änderungen durch Ergänzungen werden in die ANListe Excel-Datei gespeichert
MsgBox "F E R T I G." & Chr(10) & "Die TXT-Datei" & Chr(10) & _
"Lodas_Import_" & strBeraternummer & "_" & strMandantennummer & "_" & strMonat & ".txt" & Chr(10) & _
"wurde im gleichen Speicherort abgelegt.", vbInformation
Close #1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End With
Fehler:
'MsgBox "FEHLER", vbCritical
Close #1
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Public Function przPersNrAusTabelleEintragen()
Dim wkbQuelle As Workbook
Dim wkbZiel As Workbook
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim strPFad As String
Dim WkSEnde As Long
Dim intBlatt As Integer
Dim strPNr As String
Dim strName As String
Dim rngTreffer As Range
Dim rngBereich As Range
Dim strAdresse As String
'Die Schritte sollen live nicht ansehbar sein
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbZiel = ActiveWorkbook
strPFad = ActiveWorkbook.Path
Workbooks.Open Filename:= _
strPFad & "\ANliste.xlsx"
Set wkbQuelle = ActiveWorkbook
wkbZiel.Activate
WkSEnde = wkbZiel.Worksheets.Count
lngZeileMax = wkbQuelle.Worksheets(1).UsedRange.Rows.Count
Set rngBereich = wkbQuelle.Worksheets(1).Range("A2:A" & lngZeileMax)
For intBlatt = 2 To WkSEnde ' Alle Arbeitblätter nacheinander durchgehen
strName = wkbZiel.Worksheets(intBlatt).cells(3, 2).Value
Set rngTreffer = rngBereich.Find _
(what:=strName, lookat:=xlWhole)
If Not rngTreffer Is Nothing Then
strAdresse = rngTreffer.Row
wkbZiel.Worksheets(intBlatt).cells(3, "O").Value = wkbQuelle.Worksheets(1).cells(strAdresse, 2).Value
End If
Next intBlatt
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wkbQuelle.Close
End Function
'Sub PersNrSpeichern()
' przPersNrInTabelleSpeichern
'End Sub
Public Function przPersNrInTabelleSpeichern()
Dim wkbQuelle As Workbook
Dim wkbZiel As Workbook
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim strPFad As String
Dim WkSEnde As Long
Dim intBlatt As Integer
Dim strPNr As String
Dim strName As String
'Die Schritte sollen live nicht ansehbar sein
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbQuelle = ActiveWorkbook
strPFad = ActiveWorkbook.Path
Workbooks.Open Filename:= _
strPFad & "\ANliste.xlsx"
Set wkbZiel = ActiveWorkbook
wkbQuelle.Activate
WkSEnde = wkbQuelle.Worksheets.Count
'lngZeileMax = wkbZiel.Worksheets(1).UsedRange.Rows.Count
lngZeile = 2
For intBlatt = 2 To WkSEnde ' Alle Arbeitblätter nacheinander durchgehen
' If wkbZiel.Worksheets(intBlatt).cells(3, "O").Value = "" Then
strName = wkbQuelle.Worksheets(intBlatt).cells(3, 2).Value
strPNr = wkbQuelle.Worksheets(intBlatt).cells(3, "O").Value
wkbZiel.Worksheets(1).cells(lngZeile, 1).Value = strName
wkbZiel.Worksheets(1).cells(lngZeile, 2).Value = strPNr
'
lngZeile = lngZeile + 1
' End If
Next intBlatt
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wkbZiel.Close
End Function
