خطا در شماره گذاری

[com12151337]

سلام بر همگی من یک جدول دارم شمال شماره طبقه و شماره اتاق است کد زیر را نوشتم و می خواهم اگر طبقه یک نوشتم در باکس شماره اتاق بفرض A101 بشه و اگر در هر همان طبقه هر چند تا اتاق بشه A 102 و A103 بشه و و طبقه دوم بفرض B103 و ...... در باکس طبقه (FLOOR) خطا میگیرد و اجازه هیچگونه عملیاتی را نمی دهد ممنون میشم کمک کنید
Dim floorNo As Long
Dim roomPrefix As String
Dim lastRoomNum As Variant
Dim nextRoomNum As Long
Dim finalRoomNumber As String

On Error GoTo ErrorHandler

If IsNull(Me.Floor) Or Me.TXTFloor = 0 Then
MsgBox "تست شکست: طبقه خالي است.", vbCritical
Cancel = True
Exit Sub
Else
floorNo = CLng(Me.TXTFloor)
End If


Select Case floorNo
Case 1: roomPrefix = "A"
Case 2: roomPrefix = "B"
Case 3: roomPrefix = "C"
Case 4: roomPrefix = "D"
Case 5: roomPrefix = "E"
Case 6: roomPrefix = "F"
Case 7: roomPrefix = "G"
Case 8: roomPrefix = "H"
Case 9: roomPrefix = "I"
Case 10: roomPrefix = "J"
Case Else
MsgBox "تست شکست: Floor خارج از محدوده است (" & floorNo & ").", vbCritical
Cancel = True
Exit Sub
End Select

lastRoomNum = DMax("[RoomNumber]", "Tbl_Rooms", "Left([RoomNumber], 1) = '" & roomPrefix & "'")

If IsNull(lastRoomNum) Then
nextRoomNum = 1
finalRoomNumber = roomPrefix & "001"
Else
' براي اطمينان، فرض مي‌کنيم که عدد بعد از کاراکتر اول قرار دارد.
lastNumStr = Mid(lastRoomNum, 2)
nextRoomNum = CLng(lastNumStr) + 1
finalRoomNumber = roomPrefix & Format(nextRoomNum, "000")
End If

' ************************************************** ***************
' *** تغيير مهم: نمايش نتيجه به جاي تخصيص ***
MsgBox "مقدار توليد شده براي RoomNumber: " & finalRoomNumber, vbInformation, "تست موفقيت آميز توليد"

' *** خط تخصيص را کامنت کنيد يا حذف نماييد ***
' Me.RoomNumber = finalRoomNumber

Cancel = True ' لغو ذخيره براي جلوگيري از تداخل با تست
Exit Sub


ErrorHandler:
MsgBox "خطاي غيرمنتظره در تست: " & err.Description, vbCritical
Cancel = True

[mazoolagh]

سلام و روز خوش
این کد هوش ساختگی هست؟
در هر صورت خواسته چندان گویا و کد هم ظاهرا کامل نیست،
فعلا کد رو در تگ VB گذاشتم تا خوانا باشه شاید دیگران بتونن کمک کنن.

Dim floorNo As Long
Dim roomPrefix As String
Dim lastRoomNum As Variant
Dim nextRoomNum As Long
Dim finalRoomNumber As String

On Error GoTo ErrorHandler

If IsNull(Me.Floor) Or Me.TXTFloor = 0 Then
MsgBox "تست شکست: طبقه خالي است.", vbCritical
Cancel = True
Exit Sub
Else
floorNo = CLng(Me.TXTFloor)
End If


Select Case floorNo
Case 1: roomPrefix = "A"
Case 2: roomPrefix = "B"
Case 3: roomPrefix = "C"
Case 4: roomPrefix = "D"
Case 5: roomPrefix = "E"
Case 6: roomPrefix = "F"
Case 7: roomPrefix = "G"
Case 8: roomPrefix = "H"
Case 9: roomPrefix = "I"
Case 10: roomPrefix = "J"
Case Else
MsgBox "تست شکست: Floor خارج از محدوده است (" & floorNo & ").", vbCritical
Cancel = True
Exit Sub
End Select

lastRoomNum = DMax("[RoomNumber]", "Tbl_Rooms", "Left([RoomNumber], 1) = '" & roomPrefix & "'")

If IsNull(lastRoomNum) Then
nextRoomNum = 1
finalRoomNumber = roomPrefix & "001"
Else
' براي اطمينان، فرض مي‌کنيم که عدد بعد از کاراکتر اول قرار دارد.
lastNumStr = Mid(lastRoomNum, 2)
nextRoomNum = CLng(lastNumStr) + 1
finalRoomNumber = roomPrefix & Format(nextRoomNum, "000")
End If

' ************************************************** ***************
' *** تغيير مهم: نمايش نتيجه به جاي تخصيص ***
MsgBox "مقدار توليد شده براي RoomNumber: " & finalRoomNumber, vbInformation, "تست موفقيت آميز توليد"

' *** خط تخصيص را کامنت کنيد يا حذف نماييد ***
' Me.RoomNumber = finalRoomNumber

Cancel = True ' لغو ذخيره براي جلوگيري از تداخل با تست
Exit Sub


ErrorHandler:
MsgBox "خطاي غيرمنتظره در تست: " & err.Description, vbCritical
Cancel = True