range objekt _worksheet fail
24.11.2021 12:39:30
CoAdmiral
ich arbeite seit ein paar Tagen an einem Excel-Makro, dass quasi automatisch Rechnungsnummern (RGNr) erzeugt, erlaubt aber dennoch menschliche Einflussmöglichkeiten.
Theorie: Direkt beim öffnen wird im sheet "RG-NR" die Nächsthöhere freie RGNr ermittelt, also i.d.R. +1 zur letzten verwendeten RGNr (aus Sheet "Log" entnommen). Beim Schließen wird die neue RGNr in "Log" abgespeichert. Nun kann es aber passieren, dass eine RGNr aus welchen Gründen auch immer, im wahren Leben nicht verwendet wurde. In diesem Fall hat der User die Option, den Eintrag im Log zu löschen, sodass diese RGNr erstmal wieder verfügbar wird. Dafür muss der User die Nummer manuell im Sheet "RG-NR" eintippen. Im "SheetChange"-Modus wird überprüft, ob die Nummer auch tatsächlich frei ist. Ist dies nicht der Fall, gibt es eine Fehlermeldung mit den Vorschlag, die nächsthöhere Nummer zu nehmen.
Problem:
So wie der Code jetzt steht, würde trotz Eingabe einer mittlerweile wieder freien Nummer, im Log die falsche RGNr abgespeichert. Dies sollte durch den Else-Bereich im "SheetChange"-Abschnitt korrigiert werden. Allerdings erhalten ich dann immer die Fehlermeldung "range objekt _worksheet fehlgeschlagen".
Kompletter Code:
Option Explicit
Public strRGNR As String
Public lngMax As Long
Public arrLogStart As Long
Private Sub Workbook_Open()
Dim arrLogStr() As Variant
Dim rng As Range
Dim i As Long
Set rng = ThisWorkbook.Worksheets("Log").Range("RG_Array")
arrLogStr = rng
arrLogStart = UBound(arrLogStr, 1)
ReDim arrLogLng(1 To UBound(arrLogStr, 1), 1) As Long
For i = LBound(arrLogStr, 1) To UBound(arrLogStr, 1)
arrLogLng(i, 1) = arrLogStr(i, 1)
Next i
lngMax = WorksheetFunction.Max(arrLogLng, 1)
lngMax = lngMax + 1
strRGNR = WorksheetFunction.NumberValue(Worksheets("RG-Nr").Range("RGNR").Value, ".", ",")
strRGNR = strRGNR + 1
strRGNR = Format(strRGNR, "00000")
Worksheets("RG-Nr").Range("RGNR").NumberFormat = "@"
Worksheets("RG-Nr").Range("RGNR").Value = strRGNR
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngLastRow As Integer
Dim shLog As Worksheet
Set shLog = Worksheets("Log")
lngLastRow = shLog.Cells(shLog.Rows.Count, "A").End(xlUp).Row
shLog.Cells(lngLastRow + 1, 1).NumberFormat = "@"
shLog.Cells(lngLastRow + 1, 1).Value = Format(strRGNR, "00000")
shLog.Cells(lngLastRow + 1, 2).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
ThisWorkbook.Save
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long
Dim strNextFree As String
Dim strCheck As String
Dim arrLog() As Variant
Dim arrLogLng() As Variant
Dim rng As Range
Dim lngMaxNr As String
Dim intString, x As Integer
Set rng = ThisWorkbook.Worksheets("Log").Range("RG_Array") 'Hier erscheint Fehlermeldung nach Einfügen der Else-Anweisung weiter unten
arrLog = rng
strNextFree = "'" & Format(lngMax, "00000")
strCheck = Worksheets("RG-Nr").Range("RGNR").Value
If Target = Worksheets("RG-Nr").Range("RGNR") Then
If Len(Target) 5 Then
MsgBox "bitte eine Rechnungsnummer im gültigen Format (""00000"") eingeben"
Range("RGNr").Select
SendKeys "{F2}"
End If
For i = LBound(arrLog, 1) To (arrLogStart)
If strCheck = arrLog(i, 1) Then
MsgBox "Die Nummer " & strCheck & " ist bereits vergeben" & vbCrLf & vbCrLf & _
"Alternativ wird " & strNextFree & " als nächste freie Nummer vorgeschlagen."
strRGNR = strNextFree
Worksheets("RG-Nr").Range("RGNR").Value = strRGNR
Else
Worksheets("RG-Nr").Range("RGNR").Value = strCheck
End If
Next i
End If
End Sub