انتحار ملف الإكسيل Kill Workbook From HD لابو البراء

بسم الله الرحمن الرحيم


KILL Workbook

اثراء لموضوع اخي الكريم ابو البراء قمت بتعديل الكود لمعرفة رقم الهارد الفزيكال

اولا هذا الكود نضعه في موديول 

 Function GetPhysicalSerial() As Variant  
   Dim obj As Object  
   Dim WMI As Object  
   Dim SNList() As String, i As Long, Count As Long  
   Set WMI = GetObject("WinMgmts:")  
   For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")  
     If obj.SerialNumber <> "" Then Count = Count + 1  
   Next  
   ReDim SNList(1 To Count, 1 To 1)  
   i = 1  
   For Each obj In WMI.InstancesOf("Win32_PhysicalMedia")  
     SNList(i, 1) = obj.SerialNumber  
     i = i + 1  
     If i > Count Then Exit For  
   Next  
   GetPhysicalSerial = SNList  
 End Function  

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

 Private Sub Workbook_Open()  
   Range("A1") = GetPhysicalSerial  
   If Range("A1") <> "31534756394a5a41304237333634202020202020" Then 'هنا نضع رقم الهارد الفيزيكال  
     With ThisWorkbook  
       .Save  
       .ChangeFileAccess Mode:=xlReadOnly  
       Kill .FullName  
       .Close SaveChanges:=False  
     End With  
   End If  
 End Sub  

لتحميل الملف من هنا

كل ما عليكم ازالة العلامات المؤشر اسفلها بالاحمر ليعمل الكود

مع مراعاة تغيير رقم السيريال

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

نقوم بنسخه الى الكود مكان الرقم الاخر ونقوم بازالة كل العلامات من امام الكود

وشكرا

شارك المقال

شاركه على فيسبوكشاركه على جوجل+