Option Explicit
Global Const cSuffix = ".xls"
Global Const cRowOffsetProcess = 10
Global Const cRowOffsetEinzelsätze = 3
Global Const cRowOffsetSummary = 2
Global Const cRowOffsetReport = 77
Global Const cColumnBestand = 6
Public Sub doProcess()
Dim tThisWorkbook As Object
Dim tWorksheetProcess As Worksheet
Dim tWorksheetLOG As Worksheet, tWorksheetLOG2 As Worksheet
Dim tWorksheetEinzelsätze As Worksheet
Dim tWorksheetSummary As Worksheet
Dim tWorksheetReport As Worksheet
Dim tsRootDir As String, tsWorkDir As String, tsFullPath As String
Dim tsBuchungskreis As String
Dim tsVerzeichnisName As String, vname2 As String
Dim tsReportType As String
Dim tsReportName As String
Dim tVerzeichniseBuchungskreis()
Dim tExcelReports()
Dim dvz(1 To 500, 1 To 10)
Dim AppExcel As Object
Dim tsVermögensverzeichnis As String
Dim tsUnterabteilung As String
Dim tsVermögensstock As String
Dim tRow As Long
Dim tRowSummary As Long
Dim tRowReport As Long
Dim tRowEinzelsätze As Long
Dim tLastRow As Long
Dim tRowLog2 As Long
Dim i As Integer
Dim tiCounterDirectory As Integer, tiCounterReport As Integer, tiCounterWorksheet As Integer
Dim tiEmptyRow As Integer
Dim z2 As Integer
Dim ESB As Double
Dim ESNr As String
Dim suchstr1, suchstr2 As String
Dim VerarbeitungEinzelbuchungskreis As Boolean
Dim tsKeyVV As String
Dim tsAmountGroup As String
Dim tvCellValue As Variant
Dim tCellValue As Double
Dim tZwSumme As Double
Dim tdZugang As Double
Dim tdAbgang As Double
Dim tSumme As Double
Dim tSummeZugang As Double
Dim tSummeAbgang As Double
Dim tSummeBestand As Double
Dim tSummeBestandEuro As Double
Dim tSummeZuganguab As Double, tSummeZuganguabEuro As Double
Dim tDiff As Double
Dim dvzz As Integer
Dim IsInArray As Boolean
Dim IsPartnerGelöscht As Boolean
Dim IsBestandNegativ As Boolean
Dim IsBuchwertNegativ As Boolean
Dim IsBestandOhneBuchwert As Boolean
Dim tDatum As String
Dim tsMsg As String
Dim flagProcess As Boolean
Dim flagBREAK As Boolean
Dim flagVortrag As Boolean
Set tWorksheetProcess = ActiveWorkbook.Worksheets("Prüfung")
Set tWorksheetSummary = ActiveWorkbook.Worksheets("Zusammenfassung")
Set tWorksheetEinzelsätze = ActiveWorkbook.Worksheets("Einzelsätze")
Set tWorksheetLOG = ActiveWorkbook.Worksheets("Log")
Set tWorksheetLOG2 = ActiveWorkbook.Worksheets("Log2")
writeLog "Initalisierung"
tsVerzeichnisName = ""
VerarbeitungEinzelbuchungskreis = False
dvzz = 1
tWorksheetProcess.Range("C10:K500").ClearContents
tWorksheetSummary.Range("A2:K500").ClearContents
Range(tWorksheetEinzelsätze.Cells(3, 1), tWorksheetEinzelsätze.Cells(50000, 7)).ClearContents
Range(tWorksheetLOG.Cells(1, 1), tWorksheetLOG.Cells(500000, 5)).ClearContents
tWorksheetLOG.Cells(1, 2) = 2
Range(tWorksheetLOG2.Cells(1, 3), tWorksheetLOG2.Cells(500000, 4)).ClearContents
tRowLog2 = 2
tWorksheetProcess.Cells(2, 6) = "Differenzenprüfung gestartet ..."
With tWorksheetProcess
.Cells(4, 12) = Time
tsBuchungskreis = .Cells(3, 4)
tsRootDir = .Cells(4, 4)
tDatum = .Cells(5, 4)
.Cells(7, 4) = "Bestand"
.Cells(7, 5) = "Zu-/Abgang"
.Cells(7, 6) = "Differenz"
.Cells(7, 7) = "VV"
.Cells(7, 8) = "Uabt"
.Cells(7, 10) = "Bestand/Bewegung"
.Cells(7, 111) = "Blatt"
If tsBuchungskreis = "" Then
MsgBox "Es wurde kein Buchungskreis ausgewählt!"
Exit Sub
Else
If tsBuchungskreis = "A" Then
VerarbeitungEinzelbuchungskreis = False
Else
VerarbeitungEinzelbuchungskreis = True
End If
End If
End With
tRow = cRowOffsetProcess
tRowSummary = cRowOffsetSummary
tRowEinzelsätze = cRowOffsetEinzelsätze
tiCounterDirectory = 0
tsVerzeichnisName = Dir(tsRootDir, vbDirectory)
Do Until tsVerzeichnisName = "" Or Left$(tsVerzeichnisName, 4) = tsBuchungskreis
tsVerzeichnisName = Dir
If tsVerzeichnisName <> "." And tsVerzeichnisName <> ".." Then
If (GetAttr(tsRootDir & tsVerzeichnisName) And vbDirectory) = vbDirectory Then
tiCounterDirectory = tiCounterDirectory + 1
ReDim Preserve tVerzeichniseBuchungskreis(tiCounterDirectory)
tVerzeichniseBuchungskreis(tiCounterDirectory) = tsVerzeichnisName
End If
End If
Loop
For i = 1 To tiCounterDirectory
ActiveWorkbook.Worksheets("Log3").Cells(i + 1, 3) = tVerzeichniseBuchungskreis(i)
Next i
writeLog "Anzahl BK (Counter): ", CDbl(tiCounterDirectory)
writeLog "Anzahl BK (UBound): ", UBound(tVerzeichniseBuchungskreis)
For tiCounterDirectory = 1 To UBound(tVerzeichniseBuchungskreis)
tSummeBestand = 0
If VerarbeitungEinzelbuchungskreis Then
tsBuchungskreis = Left(tsVerzeichnisName, 4)
Else
tsBuchungskreis = Left(tVerzeichniseBuchungskreis(tiCounterDirectory), 4)
tsVerzeichnisName = tVerzeichniseBuchungskreis(tiCounterDirectory)
End If
tsWorkDir = tsRootDir & tsVerzeichnisName & "\"
tiCounterReport = 0
tsReportName = Dir(tsWorkDir, vbDirectory)
Do While tsReportName <> ""
tsReportName = Dir
If Left(tsReportName, 9) = "REPORT_VV" And Right(tsReportName, 12) = tDatum & cSuffix Then
tiCounterReport = tiCounterReport + 1
ReDim Preserve tExcelReports(tiCounterReport)
tExcelReports(tiCounterReport) = tsReportName
End If
For i = 1 To tiCounterReport
ActiveWorkbook.Worksheets("Log3").Cells(i + 1, 4) = tExcelReports(i)
Next i
Loop
If tiCounterReport > 0 Then
writeLog "Verarbeitung Vermögensverzeichnis -- Anzahl (CounterReport):", CDbl(tiCounterReport)
For tiCounterReport = 1 To UBound(tExcelReports)
DoEvents
If Worksheets("Prüfung").lstProcess = "STOP" Then
tWorksheetProcess.Activate
tWorksheetProcess.Range("F2") = "!!! PRÜFUNG ABBGEBROCHEN !!!"
DoEvents
MsgBox "STOP-Befehl in Auswahl!" & vbCrLf & "Verarbeitung abgebrochen!", vbInformation + vbOKOnly, "VV-Prüfung"
Exit Sub
End If
tsVermögensverzeichnis = Mid(tExcelReports(tiCounterReport), 10, 2)
If Mid(tExcelReports(tiCounterReport), 1, 11) = "REPORT_VV09" Then
tsUnterabteilung = Mid(tExcelReports(tiCounterReport), 15, 2)
Else
tsUnterabteilung = Mid(tExcelReports(tiCounterReport), 14, 2)
End If
If Mid(tExcelReports(tiCounterReport), 1, 11) = "REPORT_VV09" Then
If Mid(tExcelReports(tiCounterReport), 18, 13) = "BESTANDSLISTE" Then
tsReportType = "Bestand"
Else
tsReportType = "Zu-/Abgang"
End If
Else
If Mid(tExcelReports(tiCounterReport), 17, 13) = "BESTANDSLISTE" Then
tsReportType = "Bestand"
Else
tsReportType = "Zu-/Abgang"
End If
End If
With tWorksheetProcess
.Cells(4, 6) = tsBuchungskreis
.Cells(8, 7) = tsVermögensverzeichnis
.Cells(8, 8) = tsUnterabteilung
.Cells(8, 10) = tsReportType
End With
tsReportName = tExcelReports(tiCounterReport)
tsFullPath = tsWorkDir & tsReportName
tsKeyVV = "'" & tsBuchungskreis & "-" & tsVermögensverzeichnis & "-" & tsUnterabteilung
Set AppExcel = CreateObject("Excel.Application")
AppExcel.Workbooks.Open tsFullPath, 0, True
writeLog "OPEN: " & tsFullPath
writeLog "Counter Sheets: ", AppExcel.Workbooks(tsReportName).Worksheets.Count, tsKeyVV
For tiCounterWorksheet = 1 To AppExcel.Workbooks(tsReportName).Worksheets.Count
IsPartnerGelöscht = False
IsBestandNegativ = False
IsBuchwertNegativ = False
IsBestandOhneBuchwert = False
tiEmptyRow = 0
Set tWorksheetReport = AppExcel.Workbooks(tsReportName).Worksheets(tiCounterWorksheet)
writeLog "Sheet: " & tWorksheetReport.Name & " (Nr: " & tiCounterWorksheet & ")"
tLastRow = cRowOffsetReport
flagProcess = True
Do While flagProcess
If tWorksheetReport.Cells(tLastRow, 1) <> "" Then
If Left(CStr(tWorksheetReport.Cells(tLastRow, 1)), 22) = "Gesamt-Anrechnungswert" _
Or Left(CStr(tWorksheetReport.Cells(tLastRow, 1)), 46) = "Übertrag aus dem Vorjahr: (Anrechnungswert) 1)" _
Or Left(CStr(tWorksheetReport.Cells(tLastRow, 1)), 46) = "Übertrag aus dem Vorjahr (Anrechnungswert): 1)" Then
flagProcess = False
End If
End If
If Trim(tWorksheetReport.Range("RegNr")) = "" Then
writeLog "BREAK PROCESSING!! Keine RegNr vorhanden und damit keine Werte", , tsKeyVV
flagProcess = False
tLastRow = 1
flagBREAK = True
End If
If tiEmptyRow > 15 Then
writeLog "BREAK PROCESSING!! Mehr als 15 Leerzeilen in Folge", , tsKeyVV
tLastRow = 1
flagProcess = False
flagBREAK = True
End If
If tWorksheetReport.Cells(tLastRow, 1) = "" Then
tiEmptyRow = tiEmptyRow + 1
Else
tiEmptyRow = 1
End If
DoEvents
If tLastRow >= 100000 Then
Debug.Print "BREAK PROCESSING!!"
writeLog "BREAK PROCESSING!! Zähler größer 100.000", , tsKeyVV
tLastRow = 1
flagProcess = False
flagBREAK = True
End If
tLastRow = tLastRow + 1
Loop
tLastRow = tLastRow - 1
If Not flagBREAK Then
writeLog tsReportType
flagVortrag = False
Select Case tsReportType
Case "Bestand"
tWorksheetProcess.Cells(4, 9) = tWorksheetReport.Cells(22, 7)
tRowReport = cRowOffsetReport
For tRowReport = cRowOffsetReport To tLastRow - 1
If InStr(1, tWorksheetReport.Cells(tRowReport, 3), "lösch") <> 0 Then
IsPartnerGelöscht = True
End If
If InStr(1, tWorksheetReport.Cells(tRowReport, 3), "deaktiviert") <> 0 Then
IsPartnerGelöscht = True
End If
If tWorksheetReport.Cells(tRowReport, 9) <> 0 And tWorksheetReport.Cells(tRowReport, 9) < 0 Then
IsBestandNegativ = True
End If
If tWorksheetReport.Cells(tRowReport, 6) <> 0 And tWorksheetReport.Cells(tRowReport, 6) < 0 Then
IsBuchwertNegativ = True
End If
If Left(tWorksheetReport.Cells(tRowReport, 1), 7) <> "Bestand" Then
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 6))
writeLog "Zelle (Spalte/Zeile) 6/" & tRowReport & " (Bestand): ", tCellValue, tsKeyVV
If tCellValue <> 0 Then
tZwSumme = tSumme + tCellValue
tSumme = tZwSumme
End If
If Not IsNumeric(tSumme) Then
MsgBox "Summe nicht numerisch"
End If
tWorksheetProcess.Cells(8, 4) = tSumme
writeLog " Summe (Bestand): ", tSumme
If CDbl(tWorksheetReport.Cells(tRowReport, 6)) <> 0 Then
ESB = CDbl(tWorksheetReport.Cells(tRowReport, 6))
z2 = tRowReport
Do Until tWorksheetReport.Cells(z2, 3) = ""
z2 = z2 + 1
Loop
ESNr = tWorksheetReport.Cells(z2 - 1, 3)
With tWorksheetEinzelsätze
.Cells(tRowEinzelsätze, 1) = ESNr
.Cells(tRowEinzelsätze, 2) = ESB
.Cells(tRowEinzelsätze, 3) = tsVermögensstock
.Cells(tRowEinzelsätze, 4) = tWorksheetReport.Name
.Cells(tRowEinzelsätze, 5) = tsVermögensverzeichnis
.Cells(tRowEinzelsätze, 6) = tsUnterabteilung
.Cells(tRowEinzelsätze, 7) = tsBuchungskreis
End With
tRowEinzelsätze = tRowEinzelsätze + 1
Else
If CDbl(tWorksheetReport.Cells(tRowReport, 9)) <> 0 Then
writeLog "Nennwert (Bestand) ohne Buchwert (Bestand)"
IsBestandOhneBuchwert = True
End If
End If
Else
tRowReport = tRowReport + 1
End If
Next tRowReport
tSummeBestand = 0
writeLog "Zelle (Spalte/Zeile) 6/" & tRowReport & " (Differenzberechnung): >" & tWorksheetReport.Cells(tRowReport, 1) & "<"
For i = 3 To 6
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, i))
writeLog "Zelle (Spalte/Zeile) " & i & "/" & tRowReport & ": ", tCellValue, tsKeyVV
If tCellValue <> 0 Then
tZwSumme = tSummeBestand + tCellValue
tSummeBestand = tZwSumme
End If
Next i
writeLog "Differenzber. SummeBestand: ", tSummeBestand
If Left(CStr(tWorksheetReport.Cells(tRowReport, 1)), 22) = "Gesamt-Anrechnungswert" _
And InStr(CStr(tWorksheetReport.Cells(tRowReport, 1)), "EUR") = 0 Then
tSummeBestandEuro = CDbl(tWorksheetReport.Cells(tRowReport + 2, 3)) _
+ CDbl(tWorksheetReport.Cells(tRowReport + 2, 4)) _
+ CDbl(tWorksheetReport.Cells(tRowReport + 2, 5)) _
+ CDbl(tWorksheetReport.Cells(tRowReport + 2, 6))
Else
tSummeBestandEuro = tSummeBestand
End If
tZwSumme = tSumme - tSummeBestand
tDiff = tZwSumme
IsInArray = False
If tSummeBestand <> 0 Then
For i = 1 To 500
If dvz(i, 1) = tsBuchungskreis And dvz(i, 2) = tsVermögensverzeichnis _
And dvz(i, 3) = tsUnterabteilung And dvz(i, 4) = tsVermögensstock _
And dvz(i, 5) = tWorksheetReport.Name Then
dvz(i, 6) = tSummeBestand
dvz(i, 9) = tSummeBestandEuro
IsInArray = True
Exit For
End If
Next i
If IsInArray = False Then
dvz(dvzz, 1) = tsBuchungskreis
dvz(dvzz, 2) = tsVermögensverzeichnis
dvz(dvzz, 3) = tsUnterabteilung
dvz(dvzz, 4) = tsVermögensstock
dvz(dvzz, 5) = tWorksheetReport.Name
dvz(dvzz, 6) = tSummeBestand
dvz(dvzz, 9) = tSummeBestandEuro
dvzz = dvzz + 1
End If
End If
Case "Zu-/Abgang"
tWorksheetProcess.Cells(4, 9) = tWorksheetReport.Cells(22, 7)
tRowReport = cRowOffsetReport
For tRowReport = cRowOffsetReport To tLastRow - 1
If InStr(1, tWorksheetReport.Cells(tRowReport, 2), "summenmäßige") <> 0 Then
tCellValue = CDbl(Trim(Right(tWorksheetReport.Cells(tRowReport, 2), 15)))
If tCellValue <> 0 Then
tZwSumme = tSumme - tCellValue
tSumme = tZwSumme
End If
Else
If InStr(1, tWorksheetReport.Cells(tRowReport, 3), "lösch") <> 0 Then
IsPartnerGelöscht = True
End If
If InStr(1, tWorksheetReport.Cells(tRowReport, 3), "deaktiviert") <> 0 Then
IsPartnerGelöscht = True
End If
If tWorksheetReport.Cells(tRowReport, 9) < -0.01 Then
IsBestandNegativ = True
End If
If tWorksheetReport.Cells(tRowReport, 6) < -0.01 Then
IsBuchwertNegativ = True
End If
tvCellValue = tWorksheetReport.Cells(tRowReport, 1)
If tvCellValue = "" Then
tsAmountGroup = ""
Else
If InStr(1, tvCellValue, "Übertrag") > 0 Then
tsAmountGroup = "Übertrag"
ElseIf InStr(1, tvCellValue, "Bestand Vortrag") > 0 Then
tsAmountGroup = "Vortrag"
flagVortrag = True
ElseIf Left(tvCellValue, 8) = "Zugänge:" Then
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
tdZugang = tCellValue
ElseIf Left(tvCellValue, 8) = "Abgänge:" Then
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
tdAbgang = tCellValue
ElseIf Left(tvCellValue, 25) = "Saldo Zu-/Abschreibungen:" Then
tsAmountGroup = "Saldo Zu-/Abschreibungen"
ElseIf Left(tvCellValue, 40) = "Saldo Zu-/Abschreibungen gem. §341c HGB:" Then
tsAmountGroup = "Saldo Zu-/Abschreibungen"
ElseIf InStr(1, tvCellValue, "Gesamt") > 0 Then
tsAmountGroup = "Gesamt"
Else
If flagVortrag = False Then
tsAmountGroup = "Zugang/Abgang"
Else
tsAmountGroup = "-"
End If
End If
End If
Select Case tsAmountGroup
Case "Übertrag", "Zugang/Abgang"
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
writeLog "Zelle (Spalte/Zeile) 4/" & tRowReport & " (Zugang):", tCellValue, tsKeyVV
tSumme = tSumme + tCellValue
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 5))
writeLog "Zelle (Spalte/Zeile) 5/" & tRowReport & " (Abgang):", tCellValue, tsKeyVV
tSumme = tSumme - tCellValue
tZwSumme = tSummeAbgang + tCellValue
tSummeAbgang = tZwSumme
If InStr(1, tWorksheetReport.Cells(tRowReport, 1), "Vorjahr") = 0 Then
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
tZwSumme = tSummeZugang + tCellValue
tSummeZugang = tZwSumme
End If
tWorksheetProcess.Cells(8, 5) = tSumme
writeLog "Summe (" & tsAmountGroup & "):", tSumme
writeLog "Summe (Zugang):", tSummeZugang
writeLog "Summe (Abgang):", tSummeAbgang
Case "Saldo Zu-/Abschreibungen"
writeLog tsAmountGroup & ":"
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
writeLog "Zelle (Spalte/Zeile) 4," & tRowReport & " :", tCellValue
If tCellValue <> 0 Then
tZwSumme = tSumme + tCellValue
tSumme = tZwSumme
End If
End Select
End If
Next tRowReport
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
writeLog "Zelle (Spalte/Zeile) 4/" & tRowReport & " (Gesamt):", tCellValue, tsKeyVV
tSummeZuganguab = CDbl(tWorksheetReport.Cells(tRowReport, 4))
If Left(CStr(tWorksheetReport.Cells(tRowReport, 1)), 22) = "Gesamt-Anrechnungswert" And InStr(CStr(tWorksheetReport.Cells(tRowReport, 1)), "EUR") = 0 Then
tSummeZuganguabEuro = CDbl(tWorksheetReport.Cells(tRowReport + 2, 3)) + CDbl(tWorksheetReport.Cells(tRowReport + 2, 4)) + CDbl(tWorksheetReport.Cells(tRowReport + 2, 5)) + CDbl(tWorksheetReport.Cells(tRowReport + 2, 6))
Else
tSummeZuganguabEuro = tSummeZuganguab
End If
tCellValue = CDbl(tWorksheetReport.Cells(tRowReport, 4))
tZwSumme = tSumme - tCellValue
tDiff = tZwSumme
IsInArray = False
If Round(tSummeZugang, 2) - Round(tdZugang, 2) <> 0 Then
With tWorksheetProcess
.Cells(tRow, 3) = "Differenz im Buchungskreis " & tsBuchungskreis & " bei den Zugängen in Höhe von "
.Cells(tRow, 6) = tSummeZugang - tdZugang
.Cells(tRow, 7) = tsVermögensverzeichnis
.Cells(tRow, 8) = tsUnterabteilung
.Cells(tRow, 9) = tsVermögensstock
.Cells(tRow, 10) = tsReportType
.Cells(tRow, 11) = tWorksheetReport.Name
writeLog .Cells(tRow, 3), .Cells(tRow, 6)
End With
tRow = tRow + 1
End If
If Round(tSummeAbgang, 2) + Round(tdAbgang, 2) <> 0 Then
With tWorksheetProcess
.Cells(tRow, 3) = "Differenz im Buchungskreis " & tsBuchungskreis & " bei den Abgängen in Höhe von "
.Cells(tRow, 6) = tSummeAbgang + tdAbgang
.Cells(tRow, 7) = tsVermögensverzeichnis
.Cells(tRow, 8) = tsUnterabteilung
.Cells(tRow, 9) = tsVermögensstock
.Cells(tRow, 10) = tsReportType
.Cells(tRow, 11) = tWorksheetReport.Name
writeLog .Cells(tRow, 3), .Cells(tRow, 6)
End With
tRow = tRow + 1
End If
If tSummeZuganguab <> 0 Then
For i = 1 To 500
If dvz(i, 1) = tsBuchungskreis And dvz(i, 2) = tsVermögensverzeichnis And dvz(i, 3) = tsUnterabteilung And dvz(i, 4) = tsVermögensstock And dvz(i, 5) = tWorksheetReport.Name Then
dvz(i, 7) = tSummeZuganguab
dvz(i, 10) = tSummeZuganguabEuro
IsInArray = True
Exit For
End If
Next i
If Not IsInArray Then
dvz(dvzz, 1) = tsBuchungskreis
dvz(dvzz, 2) = tsVermögensverzeichnis
dvz(dvzz, 3) = tsUnterabteilung
dvz(dvzz, 4) = tsVermögensstock
dvz(dvzz, 5) = tWorksheetReport.Name
dvz(dvzz, 7) = tSummeZuganguab
dvz(dvzz, 10) = tSummeZuganguabEuro
dvzz = dvzz + 1
End If
End If
End Select
End If
With tWorksheetProcess
If tDiff > 1 Or tDiff < -1 Then
.Cells(tRow, 3) = "Differenz im Buchungskreis " & tsBuchungskreis & " in Höhe von "
.Cells(tRow, 6) = tDiff
.Cells(tRow, 7) = tsVermögensverzeichnis
.Cells(tRow, 8) = tsUnterabteilung
.Cells(tRow, 9) = tsVermögensstock
.Cells(tRow, 10) = tsReportType
.Cells(tRow, 11) = tWorksheetReport.Name
tRow = tRow + 1
End If
tSumme = 0
tSummeZugang = 0
tSummeAbgang = 0
tsMsg = "Im Buchungskreis " & tsBuchungskreis & " im Vermögensverzeichnis " & tsVermögensverzeichnis & ", Uabt " & tsUnterabteilung & ", Sparte " & tWorksheetReport.Name
If IsPartnerGelöscht = True Then
.Cells(tRow, 3) = tsMsg & " befinden sich höchstwahrscheinlich gelöschte Partner! (" & tsReportType & ")"
tRow = tRow + 1
IsPartnerGelöscht = False
End If
If IsBestandNegativ = True Then
.Cells(tRow, 3) = tsMsg & " befinden sich negative Nominalbestände! (" & tsReportType & ")"
tRow = tRow + 1
IsBestandNegativ = False
End If
If IsBuchwertNegativ = True Then
.Cells(tRow, 3) = tsMsg & " befinden sich negative Buchwerte! (" & tsReportType & ")"
tRow = tRow + 1
IsBuchwertNegativ = False
End If
If IsBestandOhneBuchwert = True Then
.Cells(tRow, 3) = tsMsg & " befinden sich Nennwerte ohne Buchwerte! (" & tsReportType & ")"
tRow = tRow + 1
IsBuchwertNegativ = False
End If
End With
If flagBREAK = True Then
tWorksheetLOG2.Cells(tRowLog2, 3) = "Verarbeitung ABGEBROCHEN ! BuKr:" & tsBuchungskreis & ", VV:" & tsVermögensverzeichnis & ", Uabt:" & tsUnterabteilung & ", VS:" & tsVermögensstock & ", Type:" & tsReportType
tWorksheetLOG2.Cells(tRowLog2, 4) = tsReportName
tRowLog2 = tRowLog2 + 1
flagBREAK = False
End If
Next tiCounterWorksheet
AppExcel.Workbooks(tsReportName).Close SaveChanges:=False
Next tiCounterReport
Else
tsMsg = "Der Buchungskreis " & tsBuchungskreis & " hat keine Vermögensverzeichnisse (oder nicht zum eingegebenen Datum)!"
tWorksheetProcess.Cells(tRow, 3) = tsMsg
tRow = tRow + 1
End If
If VerarbeitungEinzelbuchungskreis Then
Exit For
End If
Next tiCounterDirectory
With tWorksheetSummary
For i = 1 To 500
If dvz(i, 1) <> "" Then
.Cells(i + 1, 1) = dvz(i, 1)
.Cells(i + 1, 2) = dvz(i, 2)
.Cells(i + 1, 3) = dvz(i, 3)
.Cells(i + 1, 4) = dvz(i, 4)
.Cells(i + 1, 5) = dvz(i, 5)
.Cells(i + 1, 6) = dvz(i, 6)
.Cells(i + 1, 7) = dvz(i, 7)
.Cells(i + 1, 8) = dvz(i, 6) - dvz(i, 7)
.Cells(i + 1, 9) = dvz(i, 9)
.Cells(i + 1, 10) = dvz(i, 10)
.Cells(i + 1, 11) = dvz(i, 9) - dvz(i, 10)
End If
Next i
End With
tWorksheetProcess.Cells(2, 6) = "Differenzenprüfung abgeschlossen!"
writeLog "Differenzenprüfung abgeschlossen!"
tWorksheetProcess.Cells(4, 13) = Time
End Sub
Public Function writeLog(pMsg As String, Optional pSumme As Double, Optional pZuordnung)
Dim tRow As Long
tRow = CLng(ActiveWorkbook.Worksheets("LOG").Cells(1, 2)) + 1
ActiveWorkbook.Worksheets("LOG").Cells(tRow, 2) = Time
ActiveWorkbook.Worksheets("LOG").Cells(tRow, 3) = pMsg
If pSumme > 0 Then
ActiveWorkbook.Worksheets("LOG").Cells(tRow, 4) = pSumme
End If
ActiveWorkbook.Worksheets("LOG").Cells(tRow, 5) = pZuordnung
ActiveWorkbook.Worksheets("LOG").Cells(1, 2) = tRow
End Function
Private Sub cmdProcess_Click()
Dim tMsg As String, tAnswer As Integer
If Range("D3") = "A" Then
tMsg = "Prüfung wird über alle Solvency-I-Buchungskreise durchgeführt!"
tAnswer = MsgBox(tMsg, vbExclamation + vbOKCancel, "VV-Prüffung")
If tAnswer = vbOK Then
flagProcess = True
Else
flagProcess = False
End If
Else
flagProcess = True
End If
If flagProcess Then
Call doProcess1
End If
End Sub