إدخال قيمة بشرط

[لزهر مدلل]

السلام عليكم

أريد إدخال قيمة في عمود بشرط أن تكون هذه القيمة تجاوزت 90 يوما من آخر إدخال لها فإذا كانت أقل تخرج رسالة تعلم بآخر تاريخ إدخال و كم يوما تبقى وأنه لا يمكن إلا بعد إنقضاء المدة

لدي ملف قمت بتعديل فيه و به userform لإدخال البياناتCastrole.xlsm

[Foksh]

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

فضلاً منك لا أمراً أخي الفاضل ما يلي :-

• لم تحدد العمود ؟
• الشرط يجب ان يتم مقارنته بقيمة موجودة ، وانت لم تقم بتحديدها ومكانها !!
• لما يتم النقر على الزر لفتح الـ UserForm ، تظهر الرسالة التالية -

- عند الـ ComboBox1 اللي هو المفروض انه في اليوزر فورم ، صحيح ؟ لكنه غير موجود  .

 

لإجراءاتكم بتصويب الملف وإعادة ارفاقه مرة أخرى ، مع إضافة بيانات مختلفة التواريخ حتى يستطيع الأخوة والأساتذة والمعلمين تقديم اقتراحاتهم  .

 

[لزهر مدلل]

السلام عليكم

- العمود b يتم إدخال البانات و c تاريخ إدخالها

الشرط هو عند إدخال القيمة المعينة يقوم بالبحث عن آخر تاريخ إدخال لها ويقارنه بتاريخ اليوم فإذا وجدها تجاوزت 90 يوما تضاف القيمة و إلا لا

 أما بالنسبة ل UserForm فقد أتيت به من ملف آخر وقمت بتعديله وأما الرسالة فلا أعرف لآنني قمت بتعديل وتركت لكم المجال لإصلاحه وتعديله

 

[محمد هشام.]

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

جرب إفراغ اليوزرفورم من جميع الأكواد السابقة ولصق الكود التالي ربما يناسبك

Option Explicit
Public Property Get WS() As Worksheet: Set WS = Sheets("RECAP MDN+DGSN"): End Property
Private Sub CommandButton1_Click()
    Const MAX_DAYS As Long = 90
    Dim a As Variant, matricule As String, xDate As Date, lastDate As Date
    Dim i As Long, tmp As Long, trouve As Boolean, jRestants As Long

    matricule = Trim(Me.TextBox2.Value)
    If matricule = "" Then MsgBox "المرجو إدخال رقم التسجيل", vbExclamation, "تنبيه": Exit Sub
    If Not IsDate(Me.TextBox3.Value) Then MsgBox "المرجو إدخال التاريخ", vbExclamation, "خطأ": Exit Sub

    xDate = CDate(Me.TextBox3.Value): a = WS.Range("B8:C22").Value

    For i = UBound(a, 1) To 1 Step -1
        If Trim(a(i, 1)) = matricule And IsDate(a(i, 2)) Then lastDate = a(i, 2): trouve = True: Exit For
    Next i

    If trouve And xDate - lastDate < MAX_DAYS Then
        jRestants = MAX_DAYS - (xDate - lastDate)
        MsgBox "يوجد تسجيل سابق بتاريخ: " & Format(lastDate, "dd/mm/yyyy") & vbCrLf & _
               "يرجى الانتظار " & jRestants & " يوم قبل التسجيل مجددا", vbExclamation, "تنبيه"
        Exit Sub
    End If

    For i = 1 To UBound(a, 1)
        If Trim(a(i, 1)) = "" Then tmp = i: Exit For
    Next i

    If tmp = 0 Then MsgBox "النطاق ممتلئ لا يمكن إضافة تسجيل جديد", vbCritical, "خطأ": Exit Sub

    a(tmp, 1) = matricule: a(tmp, 2) = xDate
    WS.Range("B8:C22").Value = a

    MsgBox "تمت إضافة التسجيل بنجاح", vbInformation
    Me.TextBox2.Value = "": Me.TextBox3.Value = ""
End Sub
                                             
'====================
      
Private Sub CommandButton4_Click()
    Dim OnRng As Variant, matricule As String, tmps As Date
    Dim i As Long, supprimé As Boolean

    matricule = Trim(Me.TextBox2.Value)
    If matricule = "" Then MsgBox "المرجو إدخال رقم التسجيل لحذفه", vbExclamation, "تنبيه": Exit Sub
    If Not IsDate(Me.TextBox3.Value) Then MsgBox "المرجو إدخال التاريخ", vbExclamation, "خطأ": Exit Sub
    tmps = CDate(Me.TextBox3.Value)
        If MsgBox("هل أنت متأكد من حذف هذا التسجيل؟" & vbCrLf & _
              "رقم التسجيل: " & matricule & vbCrLf & _
              "تاريخ التسجيل: " & Format(tmps, "dd/mm/yyyy"), _
              vbYesNo + vbQuestion, "تأكيد الحذف") = vbNo Then Exit Sub

    OnRng = WS.Range("B8:C22").Value
    supprimé = False

    For i = 1 To UBound(OnRng, 1)
        If Trim(OnRng(i, 1)) = matricule And IsDate(OnRng(i, 2)) And CDate(OnRng(i, 2)) = tmps Then
            OnRng(i, 1) = "": OnRng(i, 2) = "": supprimé = True: Exit For
        End If
    Next i

    If supprimé Then
        WS.Range("B8:C22").Value = OnRng
        MsgBox "تم حذف التسجيل بنجاح", vbInformation
    Else
        MsgBox "لم يتم العثور على التسجيل المطلوب", vbExclamation, "غير موجود"
    End If
    Me.TextBox2.Value = "": Me.TextBox3.Value = ""
End Sub

 

Castrole v2.xlsm

[لزهر مدلل]

السلام عليكم

مشكور أخي الكريم ممكن تعديل إذا أمكن في UserForm خانة التاريخ يكتب تاريخ اليوم تلقائيا أي أقوم بالكتابة في الخانة الأولى فقط.

بارك الله فيكم

[محمد هشام.]

16 ساعات مضت, لزهر مدلل said:

خانة التاريخ يكتب تاريخ اليوم تلقائيا أي أقوم بالكتابة في الخانة الأولى فقط

Private Sub UserForm_Initialize()
    Me.TextBox3.Value = Format(Date, "dd/mm/yyyy")
    Me.TextBox3.Locked = True
    Me.TextBox2.Value = ""
End Sub

 

Castrole v3.xlsm