ملء الحقول إلزامي

[mooon984]

السلام عليكم

هل يوجد كود لملء الحقول الزامى بحيث يمنع الانتقال الى sheet اخر الا بعد ملء الحقول كلها و اذا امتلئت الحقول ما عدا حقل تظهر رساله بالحقل اللازم استيفائه 

 

 

Book1.xlsx

[سليم حاصبيا]

جرب هذا الماكرو

Option Explicit

Private Sub Worksheet_Deactivate()
Dim cont%
Dim i%, st$
Dim sh_name$

sh_name = ActiveSheet.Name
cont = Application.CountA(Sheets("Sheet1").Range("d5:d11"))
If cont <> 7 Then
For i = 5 To 11
 If Me.Range("d" & i) = vbNullString Then
  st = st & Me.Range("d" & i).Address & " ,"
 End If
 Next
 End If
If st <> vbNullString Then
    Sheets("Sheet1").Select
    MsgBox "I can't leave the Sheet" & Chr(10) & "We have empty cells, :" _
    & Chr(10) & Mid(st, 1, Len(st) - 2) & ".", 64
 Else
    Sheets(sh_name).Select
End If
 
End Sub

الملف مرفق

 

No_Out.xlsm

[بن علية حاجي]

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

وضعت الكود التالي في حدث الشيت الخاص بالحقول : 

Private Sub Worksheet_Deactivate()
  If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: MsgBox "هناك بعض الحقول فارغة! لا يمكنك الخروج من الشيت"
End Sub

تجد ذلك في الملف المرفق...

بن علية حاجي

Book1.xlsm

[سليم حاصبيا]

مشكور اخيبم علية

لكن ورد شرظ تظهر رساله بالحقل اللازم استيفائه لذلك اضطررت الى هذا الكود الطويل بعض الشيء

[سليم حاصبيا]

 

كود اخر و اقصر (مع عدم السماح بكتابة أكثر او اقل من 11 رقماً في الخلية D8)

 

Option Explicit

Private Sub Worksheet_Deactivate()
Dim my_rg As Range
On Error Resume Next
Set my_rg = Sheets("Sheet1") _
.Range("d5:d11").SpecialCells(4)
On Error GoTo 0
  If Not my_rg Is Nothing Then
   Sheets("Sheet1").Select
    MsgBox "There Are Empty Cells:" & my_rg.Address
     End If
End Sub

الملف مرفق

 

No_Out_New.xlsm

[بن علية حاجي]

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

أخي سليم، الكود الذي أنجزته رائع جدا والكود الثاني أروع، ولم أكن أعلم أن صاحب الموضوع طلب عناوين الخلايا (الحقول) الفارغة... وقد قمت بالتعديل على الكود السابق بما يلي: 

Private Sub Worksheet_Deactivate()
  For I = 1 To 7
     If Cells(I + 4, 4) = "" Then S = S & "$D$" & I + 4 & ", "
  Next
  If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: _
      MsgBox " : لا يمكنك الخروج من الشيت. هناك حقول فارغة في الخلايا التالية" & Chr(10) & Mid(S, 1, Len(S) - 2)
End Sub

بن علية حاجي

Book1.xlsm

[Ali Mohamed Ali]

بارك الله فيكم جميعا وجزاكم الله كل خير مجهودات ممتازة وعمل رائع

[mooon984]

جزاكم الله خيرااااا 

انا متشكر ليكم جدااااااااا و يارب ربنا ينفعكم بعلمكم اللى مبتبخلوش بيه على حد

[mooon984]

لو سمحتم ان قابلنى شيت من موقع اجنبى فيه كود لنفس الفكره بس انا مش فاهمه ياريت لو حد يساعدنى انى اطبقه على الملف Book1

 

 

Sales Invoicing - Offline .xlsm

تم تعديل فبراير 6, 2019 بواسطه mooon984

[mooon984]

للرفع