كود VBA اكسل - لا يمكن فتح ملف الاكسل على اي جهاز كمبيوتر حتى يتم السماح له بذلك

[CFAMURAD]

كود VBA  اكسل - لا يمكن فتح ملف الاكسل على اي جهاز كمبيوتر حتى يتم السماح له بذلك

[محمد هشام.]

يمكنك وضع الكود التالي في  Private Sub Workbook_Open

Private Sub Workbook_Open()
' هنا اسماء الاجهزة المسموح للمصنف الاشتغال عليها

If Environ("computername") <> "CFAMURAD" And Environ("computername") <> "Officena" Then

'عند عدم تحقق الشرط يتم اظهار الرسالة وغلق الملف
    
  Application.DisplayAlerts = False
    MsgBox " لا يمكنك تشغيل هدا المصنف على هدا الكمبيوتر " & _
         vbLf & vbLf & "  .......... المرجوا الاتصال", _
         vbOKOnly + vbExclamation + vbDefaultButton1 + vbApplicationModal, "معلومات"
    ThisWorkbook.Close
   Application.DisplayAlerts = True
End If
End Sub

يستحسن وضع باسوورد لمحرر الاكواد لكي لا يتم التلاعب بالملف 

 

 

 

فتح المصنف على اجهزة محددة.rar

[CFAMURAD]

هل يمكن عمل ذلك من خلال UUID ?

[saad821]

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

تم تعديل يوليو 13 بواسطه saad821

[عبدالله فاروق ابو ريان]

ممتاز

[محمد هشام.]

في 13‏/7‏/2024 at 16:51, saad821 said:

حين نقوم بتعطيل وحدات الماكرو فان الكود لا يعمل والملف يمكن فتحه والتعديل عليه

لقد سبق الاشارة الى انه يفضل اظافة باسوورد لمحرر الاكواد تفاديا لهدا 

Password  3698

 

فتح المصنف على اجهزة محددة.xlsm

تم تعديل يوليو 15 بواسطه محمد هشام.

[saad821]

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

فتح المصنف على اجهزة محددة.xlsm

[أبو الخضر البعيثي]

في 16‏/7‏/2024 at 01:04, محمد هشام. said:

لقد سبق الاشارة الى انه يفضل اظافة باسوورد لمحرر الاكواد تفاديا لهدا 

Password  3698

 

فتح المصنف على اجهزة محددة.xlsm 13.04 kB · 16 downloads

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

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

تحياتي لكم جميعا

[محمد هشام.]

ادن جرب هدا ربما يفيدك 

Sub Locked(ByVal bEnabled As Boolean)
Dim sh As Worksheet, tmp As Integer, Cnt As Integer
Set WS = Sheets("واجهة البرنامج")
If bEnabled = True Then
    Cnt = -1  '<<====  Visible
    tmp = 2 '<<====  Hidden
Else
    Cnt = 2
    tmp = -1
End If
With ThisWorkbook
On Error Resume Next
    Application.ScreenUpdating = False
    WS.Visible = Cnt
    For Each sh In .Sheets
        If Not sh.Name = WS.Name Then
            sh.Visible = tmp
        End If
    Next sh
    WS.Visible = Cnt
    Application.ScreenUpdating = True
    On Error GoTo 0
  End With
End Sub
Sub Verification()
With ThisWorkbook
    Application.DisplayAlerts = False
    If .Path <> vbNullString Then
       .ChangeFileAccess xlReadOnly
       ' Kill .FullName  '<<====  لحدف المصنف نهائيا
    End If
    .Close SaveChanges:=False
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Locked True
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:="1234"
End Sub

Private Sub Workbook_Open()
Select Case Environ("COMPUTERNAME")
Case "HP ZBook Power", "Your device name"          ' '<<==== أسماء أجهزة الكمبيوتر المعتمدة
        Locked False
ActiveWorkbook.Unprotect "1234"
    Case Else
        Verification
End Select
End Sub

Password 1234

 

فتح المصنف على اجهزة محددة.xlsm

[mahmoud nasr alhasany]

احسنت جزاك الله خيرا

تم تعديل يوليو 27 بواسطه mahmoud nasr alhasany