ممنوعات الادخال

[عادل ابوزيد]

السلام عليكم

بالملف المرفق يقوم مدخل البيانات بادخال رقم الحالة باكثر من طريقة تم حصر الاخطاء كالاتى 

1 - لا يستخدم الشرطة المائلة ( / ) كما فى الحالة الاولى .. وانما يستخدم الشرطة ( - ) كما فى باقى الحالات

2 - لا يكتب الصفر ( 0 ) بعد الشرطة ( - ) كما فى الحالة الثالثة و  العاشرة

3 - لا يكتب الصفر ( 0 ) بعد الحرف الانجليزى ان وجد كما فى الحالة الخامسة

وعند قيام مدخل البيانات بتنفيذ احد هذه المحظورات او كلها تظهر رسالة تصحيح ولا يتم الادخال

Book1.xlsx

[hegazee]

و عليكم السلام ورحمة الله و بركاته

جرب الكود التالي في حدث الصفحة

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim inputValue As String
    Dim parts() As String
    Dim secondPart As String
    Dim hasLetter As Boolean
    Dim letterPos As Integer
    Dim i As Integer
    Dim errorMsg As String

    ' التحقق من أن التغيير حدث في العمود E (العمود الخامس)
    If Not Intersect(Target, Me.Columns(5)) Is Nothing Then
        Application.EnableEvents = False ' تعطيل الأحداث مؤقتًا لتجنب التكرار
        For Each cell In Intersect(Target, Me.Columns(5))
            If Not IsEmpty(cell) Then
                inputValue = Trim(cell.Value)
                errorMsg = ""

                ' التحقق من وجود الشرطة المائلة (/)
                If InStr(inputValue, "/") > 0 Then
                    errorMsg = errorMsg & "خطأ: يجب استخدام الشرطة العادية (-) بدلاً من الشرطة المائلة (/)." & vbCrLf
                End If

                ' التحقق من التنسيق العام
                If InStr(inputValue, "-") > 0 Then
                    parts = Split(inputValue, "-")
                    If UBound(parts) = 1 Then
                        secondPart = parts(1)
                        
                        ' التحقق من وجود صفر في بداية الجزء الثاني
                        If Left(secondPart, 1) = "0" Then
                            errorMsg = errorMsg & "خطأ: لا يُسمح بوجود صفر (0) بعد الشرطة (-)." & vbCrLf
                        End If

                        ' التحقق من وجود حرف إنجليزي في الجزء الثاني
                        hasLetter = False
                        letterPos = 0
                        For i = 1 To Len(secondPart)
                            If secondPart Like "*[a-zA-Z]*" Then
                                hasLetter = True
                                Exit For
                            End If
                        Next i

                        ' التحقق من وجود صفر بعد الحرف الإنجليزي (إن وجد)
                        If hasLetter Then
                            letterPos = InStr(secondPart, Left(secondPart, 1))
                            If letterPos > 0 And Mid(secondPart, letterPos + 1, 1) = "0" Then
                                errorMsg = errorMsg & "خطأ: لا يُسمح بوجود صفر (0) بعد الحرف الإنجليزي." & vbCrLf
                            End If
                        End If
                    Else
                        errorMsg = errorMsg & "خطأ: تنسيق رقم الحالة غير صحيح. يجب أن يكون على شكل (أرقام-أرقام) أو (أرقام-حرف أرقام)." & vbCrLf
                    End If
                Else
                    errorMsg = errorMsg & "خطأ: يجب أن يحتوي رقم الحالة على شرطة عادية (-)." & vbCrLf
                End If

                ' إذا كان هناك خطأ، عرض رسالة تحذير وإلغاء الإدخال
                If errorMsg <> "" Then
                    MsgBox errorMsg, vbCritical, "خطأ في إدخال رقم الحالة"
                    cell.Value = ""
                End If
            End If
        Next cell
        Application.EnableEvents = True ' إعادة تفعيل الأحداث
    End If
End Sub

 

Book1.xlsm

[Foksh]

وعليكم السلام ورحمة الله وبركاته ,,

هذه محاولة بسيطة قد لا تكون بدقة فكرة الأستاذ @hegazee :-

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, val As String
    Dim regex As Object

    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "^\d{1,2}-([a-zA-Z][1-9]\d*|[1-9]\d*[a-zA-Z]?)$"

    For Each c In Intersect(Target, Columns("E"))
        If Not IsEmpty(c) Then
            val = c.Value
            If Not regex.Test(val) Or Len(val) > 8 Then
                MsgBox "صيغة غير صحيحة! يجب أن تكون:" & vbCrLf & vbCrLf & _
                       "تستخدم شرطة (-) فقط (.1)" & vbCrLf & _
                       "لا تبدأ الأرقام بصفر (.2)" & vbCrLf & _
                       "لا يوجد صفر بعد الحرف الإنجليزي (.3)" & vbCrLf & _
                       "(12-a1234 :مثال ) الحد الأقصى 8 أحرف (.4)", _
                       vbExclamation + vbMsgBoxRight, "تصحيح"
                Application.Undo
            End If
        End If
    Next c
End Sub

 

جربها وأخبرنا بالنتيجة ..

تم تعديل منذ 4 ساعات بواسطه Foksh
ضبط نص الرسالة في الكود فقط

[عادل ابوزيد]

الاستاذ الفاضل حجازى  @hegazee

ما شاء الله رائع واسمح لى بطلب اضافة شرط ان يكون الحد الاقصى للارقام والحروف بعد الشرطة 5 والحد الاقصى للارقام قبل الشرطة 2 رقمين فقط

تقبل تحياتى وشكرى

الاستاذ الفاضل Foksh

اشكرك من اعماق قلبى على الاهتمام وجعله الله فى ميزان حسناتك .. اسمح لى ببعض الوقت للتجربة .. الا اننى على يقين بتمام العمل ان شاء الله 

برجاء تقبل شكرى وتقديرى لشخصكم الكريم

[محمد هشام.]

وعليكم السلام ورحمة الله وبركاته

استكمالا لما تفضل به الأساتذة @Foksh  و @hegazee  من حلول مشكورة  و إثراءا للموضوع أضع بين يديك اقتراحا إضافيا  ربما قد يكون مناسبا لطلبك 

Private Sub Worksheet_Change(ByVal Target As Range)
Const ColF As Long = 5, Irow As Long = 2, Max As Long = 5
Dim rng As Range, i As Long, ky() As String, Cnt$, tmp$, msg$, txt$
If Target.Column = ColF Then
    On Error GoTo Cleanup
    SetApp False
    For Each rng In Target
        txt = Trim(CStr(rng.Value)): msg = ""
        If txt = "" Then GoTo NextCell
        If InStr(txt, "/") > 0 Then msg = "(/) " & _
        "خطأ: يرجى استخدام الشرطة العادية (-) بدلا من الشرطة المائلة"
        If msg = "" And InStr(txt, "-") = 0 Then msg = "خطأ: التنسيق غير صحيح"
        If msg = "" Then
            ky = Split(txt, "-")
            If UBound(ky) <> 1 Then
                msg = "خطأ: يجب أن يكون التنسيق بالشكل (رقم-رموز)"
            Else
                Cnt = ky(0): tmp = ky(1)
                If msg = "" And (Not IsNumeric(Cnt) Or Len(Cnt) < 1 Or Len(Cnt) > Irow) Then _
                msg = "خطأ: الجزء الأول يجب أن يكون رقمًا مكونا من رقم أو رقمين فقط"
                If msg = "" And Len(tmp) > Max Then msg = "خطأ: الحد الأقصى للرموز بعد الشرطة هو 5 رموز"
                If msg = "" And Left(tmp, 1) = "0" Then msg = "خطأ: لا يسمح ببدء الجزء الثاني بصفر"
                For i = 1 To Len(tmp) - 1
                    If msg = "" And Mid(tmp, i, 1) Like "[A-Za-z]" And Mid(tmp, i + 1, 1) = "0" Then
                        msg = "خطأ: لا يسمح بوجود صفر بعد الحرف الإنجليزي": Exit For
                    End If
                Next i
            End If
        End If
        If msg <> "" Then MsgBox msg, vbCritical, "خطأ في إدخال رقم الحالة": rng.Value = ""
NextCell:
    Next rng
End If
Cleanup:
SetApp True
End Sub
Private Sub SetApp(ByVal enable As Boolean)
With Application
    .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable
    .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub

 

Book1 v2.xlsm