اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم
كل التوفيق لهذا المنتدى الرائع و القائمين عليه

لدي سؤال:
أريد رسالة تنبثق عند الخروج من خلية فارغة في ورقة العمل في إكسل
عملت ملف مرفق ولكن هذا الملف يعمل عند تفريع الخلية و ليس عندما تكون هي بالأصل فارغة.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "" Then
MsgBox "Please fill the cell before you leave", vbCritical, "Warninng"
Target.Select
End If
End Sub

وشكرا مسبقا



 

Test.rar

قام بنشر

وعليكم السلام

ممكن تجرب هذا الكود

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
Dim bIsEmpty As Boolean
bIsEmpty = False
For Each cell In Range("A1:Z1000")
    If IsEmpty(cell) = True Then
        'An empty cell was found. Exit loop
        bIsEmpty = True
        Exit For
    End If
Next cell
If bIsEmpty = True Then
    'There are empty cells in your range
    '**PLACE CODE HERE**
    MsgBox "There are empty cells in your range"
Else
    'There are NO empty cells in your range
    '**PLACE CODE HERE**
    MsgBox "All cells have values!"
End If
End Sub

 

قام بنشر

ألف شكر لردك السريع وجزاك الله كل خير

أخ علي
طلبي هو : الحدث عند الخروج من حلية معينة

مثلا: انا كنت في الخلية A1 فإذا أنا كتبت فيها شيئا حرف أو رقم لا تظهر اية رسائل تنبيه وإذا تركتها فارغة وانتقلت الى A2 او B1 تظهر رسالة تنبهني ان الخلية السابقة فارعة ويرجع التركيز إلى A1

ولكم كل الشكر

قام بنشر

يتم تنفيذهذا في الأكسس في نموذج

ويسهل أيضا في الإكسل في نموذج

لكن في خلايا الإكسل فالكود السابق رائع لهذا الغرض ويمكن إضافة حدث عند تغيير التحديد كذلك

ليصبح الكود هكذا

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "" Then
MsgBox "Please fill the cell before you leave", vbCritical, "Warninng"
Target.Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Value = "" Then
MsgBox "Please fill the cell before you leave", vbCritical, "Warninng"
Target.Select
End If
End Sub

 

  • Like 1
قام بنشر

بارك الله فيك أستاذ محمد وألف شكر ليك وللأستاذ علي

حاول الإنتقال من خلية إلى أخرى ستجد ان الرسالة تظهر في حالة الخلية السابقة فارغة أو غير فارغة, وليس هذا المطلوب
اما في نموذج أكسس فلا
فقط عندما يكون الحقل الذي انت فيه فارغ وتحاول الإنتقال إلى حقل آخر تظهر رسالة انه يجب عليك إملاء الحقل ويعود التركيز إلى الحقل الفارغ

حاولت مرارا ان اجد الحدث عند الخروج من خلية "Event on Exit" في ورقة العمل ولم اجد
فقط هنالك   Worksheet_Change   
               worksheet_selectionchange
لدي مثال آخر
عندما أحدد النطاق في ورقة العمل وليكن العمود A:A
وعند ادخال البيانات في هذا العمود بمجرد إدخال قيمة مكررة تظهر رسالة أنه قد تم إدخال هذه القيمة مسبقا فيتم الغاء القيمة المكررة ويرجع التركيز إلى الخلية التي كتبت فيها القيمة المكررة. وهنا ليس نموذج بل ورقة عمل في اكسل.

ودمتم

قام بنشر
منذ ساعه, خليل خليل داماس said:

حاول الإنتقال من خلية إلى أخرى ستجد ان الرسالة تظهر في حالة الخلية السابقة فارغة أو غير فارغة, وليس هذا المطلوب

الكود لا يهتم بالخلية السابقة

الكود يهتم بالخلية الحالية التي يتم تغييرها أو تحديدها

................

أقترح عمل نموذج إدخال إذا كنت حريصا على تنفيذ هذه الميزة

قام بنشر (معدل)
في ١٩‏/٨‏/٢٠١٨ at 07:22, خليل خليل داماس said:

ألف شكر لردك السريع وجزاك الله كل خير

أخ علي
طلبي هو : الحدث عند الخروج من حلية معينة

مثلا: انا كنت في الخلية A1 فإذا أنا كتبت فيها شيئا حرف أو رقم لا تظهر اية رسائل تنبيه وإذا تركتها فارغة وانتقلت الى A2 او B1 تظهر رسالة تنبهني ان الخلية السابقة فارعة ويرجع التركيز إلى A1

ولكم كل الشكر

ليس هنالك حدث عند الخروج من خلية لكن يمكن تحقيق ما طلبته بشئ من الكود

أضف الكود التالي الى ThisWorkbook Module :

Option Explicit

Private oPrevCell As Range
Private Const TARGET_SHEET = "Sheet1" '<== Change Target Sheet as required.
Private Const TARGET_CELL = "A1" '<== Change Target Cell as required.

Private Sub Workbook_Activate()
    Call StoreTargetCell
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call StoreTargetCell
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Xit
    If Sh Is Sheets(TARGET_SHEET) Then
        If Union(Target, Range(TARGET_CELL)).Address = Target.Address Then
            Set oPrevCell = Range(TARGET_CELL)
        Else
            If IsEmpty(oPrevCell) Then
                Application.EnableEvents = False
                Range(TARGET_CELL).Activate
                MsgBox "Oops!" & vbCrLf & vbCrLf & "You Can't Leave Cell : '" & TARGET_CELL & "' Empty", vbCritical
            End If
        End If
    End If
Xit:
    Application.EnableEvents = True
End Sub

Private Sub StoreTargetCell()
    If ActiveSheet Is Sheets(TARGET_SHEET) Then
       Set oPrevCell = IIf(ActiveCell.Address = Range(TARGET_CELL).Address, ActiveCell, Nothing)
    End If
End Sub

 

الكود أعلاه يفترض أن الخلية المقصودة هي خلية A1 في الورقة Sheet1.. عدل ال Constants الموجودتان في أعلا الكود حسب الاحتياج

تم تعديل بواسطه جعفر الطريبق
  • Like 1
قام بنشر

السلام عليكم
كل عام وأنتم بألف خير و ينعاد عليكم بالصحة و الخير و البركات
ألف شكر لكل الردود : الأخ علي و الأستاذ محمد والاخ جعفر وبارك الله في جهودكم
أود أن اعتذر من الأخ جعفر على تأخري في الرد عليه
بالنسبة لكود الأخ جعفر جهد جبّار و بارك الله فيك

انا عملت شي مختلف شوي بتمنى ينال إعجابكم
والطريقة هي انه عند الحدث "SelectionChange" يتم استدعاء المفتاح {BS} او {BackSpace}
و بالتالي الكود الذي طرحته انا يعمل وإليكم المثال بالمرفق
أتمنى من الأخوة الأفاضل تجربة الملف
ولكم كل الشكر و التقدير

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.valuse = "" Then
MsgBox "Oops!" & vbCrLf & vbCrLf & "You can't leave the cell   . . . . . . it's empty", vbCritical
Target.Select
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Call SendKeys("{BS}", True)
End Sub

Test.rar

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information