بما إنه والحمد لله ، ما حدش تعصب .. هاي فكرتي البسيطة ..
Option Compare Database
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal l00OO1lIOI1O As LongPtr, ByVal O0lllIIl1I1 As Long, ByVal II0IOII1l1 As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal l00OO1lIOI1O As LongPtr) As Long
Private lll0I01OI1I As LongPtr
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal l00OO1lIOI1O As Long, ByVal O0lllIIl1I1 As Long, ByVal II0IOII1l1 As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal l00OO1lIOI1O As Long) As Long
Private lll0I01OI1I As Long
#End If
Public Sub Ill10l0IIll0()
If lll0I01OI1I <> 0 Then IOII11IIOIO10
lll0I01OI1I = SetTimer(0, 1, 0, AddressOf IOOl1IlOOOll)
If lll0I01OI1I <> 0 Then
End If
End Sub
Public Sub IOII11IIOIO10()
If lll0I01OI1I <> 0 Then
KillTimer 0, lll0I01OI1I
lll0I01OI1I = 0
End If
End Sub
#If VBA7 Then
Public Sub IOOl1IlOOOll(ByVal hwnd As LongPtr, ByVal IIO11OlII11 As Long, ByVal I0l110IlOI01I As LongPtr, ByVal OO1IOI100OO As Long)
#Else
Public Sub IOOl1IlOOOll(ByVal hwnd As Long, ByVal IIO11OlII11 As Long, ByVal I0l110IlOI01I As Long, ByVal OO1IOI100OO As Long)
#End If
On Error Resume Next
Dim lIII0O0O11Il As Object
Set lIII0O0O11Il = CallByName(Application, ChrW(86) & ChrW(66) & ChrW(69), VbGet)
Dim IlIO10OI1 As Object
Set IlIO10OI1 = CallByName(lIII0O0O11Il, ChrW(77) & ChrW(97) & ChrW(105) & ChrW(110) & ChrW(87) & ChrW(105) & ChrW(110) & ChrW(100) & ChrW(111) & ChrW(119), VbGet)
If CallByName(IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbGet) = True Then
CallByName IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbLet, False
End If
Set lIII0O0O11Il = CallByName(Application, ChrW(86) & ChrW(66) & ChrW(69), VbGet)
Set IlIO10OI1 = CallByName(lIII0O0O11Il, ChrW(77) & ChrW(97) & ChrW(105) & ChrW(110) & ChrW(87) & ChrW(105) & ChrW(110) & ChrW(100) & ChrW(111) & ChrW(119), VbGet)
If CallByName(IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbGet) = True Then
CallByName IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbLet, False
End If
End Sub
والإستدعاء يكون في زري التشغيل والايقاف :-
Private Sub Btn_Stop_Click()
IOII11IIOIO10
End Sub
Private Sub Btn_Start_Click()
Ill10l0IIll0
End Sub
الملف للتجربة :-
VBA Kill Obfuscate Code.accdb