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

[تحيا مصر]

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

 

 

 

[Ali Mohamed Ali]

السلام عليكم 

اولا عليك بإنشاء صفحة جديدة فى ملفك تحت اسم  Welcome

ثم بعد ذلك عليك بفتح موديول جديد ووضع فيه هذان الكودين :

Sub CommitSuicide()
With ThisWorkbook
    Application.DisplayAlerts = False
    If .Path <> vbNullString Then
        .ChangeFileAccess xlReadOnly
        Kill .FullName
    End If
    .Close SaveChanges:=False
End With
End Sub


Sub Locked(ByVal bEnabled As Boolean)
Dim sh As Worksheet
Dim iHome As Integer
Dim iOthers As Integer


If bEnabled = True Then
    iHome = -1  'visible
    iOthers = 2 'very hidden
Else
    iHome = 2
    iOthers = -1
End If
With ThisWorkbook
    On Error Resume Next
    Application.ScreenUpdating = False
    .Sheets("Welcome").Visible = iHome
    For Each sh In .Sheets
        If Not sh.Name = "Welcome" Then
            sh.Visible = iOthers
        End If
    Next sh
    .Sheets("Welcome").Visible = iHome
    Application.ScreenUpdating = True
    On Error GoTo 0
End With
End Sub

ثم بعد ذلك ضع هذان الكودين فى حدث ThisWorkBook

وعليك بوضع اسم  كمبيوترك  داخل الأقواس  اللى فى هذا السطر من الكود

Select Case Environ("COMPUTERNAME")

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Locked True
End Sub


Private Sub Workbook_Open()
Select Case Environ("COMPUTERNAME")
    Case "LPPC28"   'approved computers
        Locked False
    Case Else
        CommitSuicide
End Select
End Sub

 

وأخيراً وضع الكود التالى فى حدث الصفحة الجديدة Welcome

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Locked False
End Sub

بارك الله فيك

[تحيا مصر]

الف الف شكر وربنا يعوض تعبك

تم تعديل أكتوبر 31, 2018 بواسطه تحيا مصر

[تحيا مصر]

عند فتح الملف يعطى خطأ

 

[Ali Mohamed Ali]

استاذى الكريم المفروض تغيير اللى بين الأقواس فى هذا السطر من الكود الى اسم جهازك

Select Case Environ("COMPUTERNAME")

 

[تحيا مصر]

عملت كده

 

 

[تحيا مصر]

وغيرت اسم الكمبيوتر الى               computername     ربما اصلح الخطأ

 

 

 

[Ali Mohamed Ali]

لأ اخى الكريم ليس هذا المطلوب

يجب عليك وضع بين الأقواس اسم جهازك انت فعلى سبيل المثال جهازى كالأتى مع اسم جهازى

Select Case Environ("AliMohamed")

 

[تحيا مصر]

اخى الف شكر لتواصلك معى

وتم التجربة بنجاح ولكن عند تجربة بعض المكرو     والمتصلة  بفتح user form    لم تعمل 

 

 

 

 

[am3h80]

اتقدم بخالص الشكر والتقدير لأاستاذنا الفاضل علي أحمد علي علي المجهوذ المبذول

ولكني أرغب في الأستفسار  عند تطبيق الأكواد سالفة الذكر لم يتم حفظ الأكواد بVBA كأن لم يتم كتابة الكود نهائياً وفي بعض الأحيان يتم حذف الملف ؟

يرجي توضيح ذلك

مع العلم باني اقوم بحفظ الملف مرة اخري

 

[Ali Mohamed Ali]

السلام عليكم اخى الكريم لابد من حفظ الملف بصيغة XLSM.

بارك الله فيك