اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حماية البيانات في الشيت وشاشة الادخال


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

السلام عليكم اخواتي أخواتي

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

تجدون الملف مرفق

فورم ادخال و تعديل مرن مع الطباعة 3ffffffff.rar

رابط هذا التعليق
شارك

السلام عليكم

بالنسبى لحماية البيانات المدخلة في الشيت من التعديل أو الحذف

تفضل

كود فك الحماية: 123

فورم ادخال و تعديل مرن مع الطباعة 3ffffffff.rar

رابط هذا التعليق
شارك

وبالنسبة لكود الحماية على مستوى البيانات المدخلة

في حدث زر إدخال سجل جديد قم بوضع هذا الكود

عند الضغط على زر إدخال سجل جديد تظهر رسالة تطالبك بكلمة المرور وهي 123

Private Sub ButtonNew_Click()
Dim PASS As String: PASS = "123"
If Application.InputBox("قم بكتابة كلمة المرور حيتى يتسنى لك إضافة السجل الجديد") <> PASS Then
MsgBox ("كلمة مرور غير صحيحة")
Else
MsgBox ("كلمة مرور صحيحة .. تفضل البيانات")
kh_AddNewRecord
End If
End Sub

في حدث زر حذف سجل الحالي قم بوضع هذا الكود

عند الضغط على زرحذف سجل الحالي تظهر رسالة تطالبك بكلمة المرور وهي 1234

Private Sub ButtonDelete_Click()
Dim PASS As String: PASS = "1234"
If Application.InputBox("قم بكتابة كلمة المرور حيتى يتسنى لك إضافة السجل الجديد") <> PASS Then
MsgBox ("كلمة مرور غير صحيحة")
Else
MsgBox ("كلمة مرور صحيحة .. تفضل البيانات")

If MsgBox("  هل تريد حذف السجل رقم : " & iRow & vbCr & vbCr & String$(40, "="), vbCritical + vbYesNo + mBox + vbDefaultButton2, "تاكيد الحذف ") = vbNo Then Exit Sub

If Me.ListFind.ListCount Then Me.ListFind.Clear
MyRngdate.Rows(iRow + 1).EntireRow.Delete
If Not tSr Then GoTo 1
If iRow = ContRow Then GoTo 1
With MyRngSeri
    .Cells(iRow + 1, 1).Value = iRow
    Range(.Cells(iRow + 1, 1), .Cells(ContRow, 1)).DataSeries
End With
1:
Me.ScrollBar1.Max = ContRow - 1
ScrollBar1_Change
Call MsgBox("  تم حذف السجل  بنجاح  ", mBox, "الحمدلله")
End If
End Sub

أما إذا اردت كلمة المرور بنطاق في ورقة العمل قم بتعديل اول سطر

Dim PASS As String: PASS = Range("A1")
رابط هذا التعليق
شارك

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