🌸 دعوة لتجربة الأداة : دكتور الVBA 🌸

[Moosak]

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

هذه دعوة كريمة لتجربة الأداة الجديدة والفريدة من نوعها :
 دكتور ال VBA

وضائف الأداة : 

1- تحويل الكود إلى صيغة متوافقة مع النواتين 32 و 64 بت.
2- تصحيح الأخطاء البرمجية في الكود.
3- تنسيق وترتيب الكود شكليا.
4- كتابة التعليقات وشرح للكود باللغتين العربية والإنجليزية.
5- إضافة صائد الأخطاء للكود وذلك لتعقب الأخطاء البرمجية.
6- إضافة ترقيم لأسطر الكود.

يمكنك اختيار واحد من هذه الوظائف أو تختار من بينها ما تريده.

الأداة مخصصة لأكواد ال VBA وتعتمد على قدرات الذكاء الاصطناعي لإعطاء نتائج دقيقة ومبهرة .. 😁✌🏻
اختصر على نفسك الوقت والجهد واعمل بذكاء 😉👌🏻

رابط الأداة :
https://vba-code-doctor-471932697586.us-west1.run.app/

يمكنك فتحها في الهاتف أو الحاسوب على راحتك 😎🌷

جربوها وعطوني رأيكم 😇✌🏻

 

[ابوخليل]

جزاك الله خيرا

جربتها على كود اعمل عليه فعلا الآن

النتيجة ممتازة .. خاصة الترتيب والتعليق

ايضا التصحيح فقد اضاف لي اغلاق وانهاء مجموعة السجلات

ولكني حين نقلته الى الفورم .. ظهر لي خطأ في سطر DlookUp  لم احقق في السبب

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

وضعت الموقع في شريط المفضلة لتكون هذه التحفة قريبا مني .. 

[Moosak]

46 دقائق مضت, ابوخليل said:

ظهر لي خطأ في سطر DlookUp  لم احقق في السبب

أسعدك الله عمي أبوخليل 🙂 ..
مرورك دائما له أثر .. 🌹
فأنت تشجع .. تتفاعل .. تنصح .. وتترك فينا الأثر 😊

ياريت بعد ما يتبين لك السبب تنبهنا .. وهل يتم تعديل الخطأ لو أعدت المحاولة مرة أخرى ؟ ..
هذا لأجل تطوير الأداة ..

وهل هناك أفكار أخرى (احتياجات) يمكن إضافتها ؟

[ابوخليل]

عجيب .. عجيب

يبدو انك عدلت على شيء ما

اعدت التجربة .. والنتيجة كانت مذهلة

التعديلات التي اجراها :

تنظيم الكود .. بحيث جعل جميع الاعلانات عن المتغيرات في الأعلى

بدل شرط الحقل النصي في الدوال بالمتغير وكذلك في جملة sql استبدل الدالة بالمتغير  .. عفريت برمجي

اضاف لي متغير اسم الموظف غفلت عن نقله من العمل السابق ... هذه الاضافة لا تخطر على بال المحترفين الا بعد عناء

اغلاق السجلات عند نهاية كل شرط .. الحقيقة هذه الحركة تحفة

هذه صورة من الخيارات التي استخدمتها :

 

وهذا الكود الاصلي :

Private Sub id_AfterUpdate()
EmpUserid = id
Dim mylevl As Boolean
mylevl = Nz(DLookup("Emp_user", "tblEmpNames", "Emp_user='" & Me.id & "'"), 0)
EmpFatrah = Nz(DLookup("fatrah", "tblEmpNames", "Emp_user='" & Me.id & "'"), 0)
If mylevl = False Then
Beep
Me.LabelH.Caption = "خطأ!! .. الادخال غير صحيح"
Me.TimerInterval = 3000
id = ""
id.SetFocus
Exit Sub
End If

Dim rs As Recordset
Dim strSql As String
strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " & vbCrLf & _
"FROM tblCheckINOut " & vbCrLf & _
"WHERE (((tblCheckINOut.EmpUser)=funEmpUserid())) " & vbCrLf & _
"ORDER BY tblCheckINOut.id DESC;"
Set rs = CurrentDb.OpenRecordset(strSql)

If rs.RecordCount = 0 Then
rs.AddNew
rs!EmpUser = id
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
Exit Sub
End If

Dim waitTime As Integer
Dim AdTim As Date
waitTime = Nz(DLookup("waitBtween", "tblTimeCtrl"), 0)
AdTim = DateAdd("n", waitTime, rs!chekInOut)
If Now() < AdTim Then
Me.id.SetFocus
Beep
Me.LabelH.Caption = "توقيع مكرر !! انتظر قليلا ..."
id = ""
Me.TimerInterval = 3000
id.SetFocus
Exit Sub
Else

If rs!chkio = "I" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "O"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "انصراف"
Me.Requery
Me.id = ""
Me.TimerInterval = 3000
Me.id.SetFocus
rs.Update
Exit Sub

ElseIf rs!chkio = "O" Then
rs.AddNew
rs!EmpUser = EmpUserid
rs!chekInOut = Now()
rs!chkio = "I"
rs!ftra_id = EmpFatrah
Me.txtnm = empName
LabelH.Caption = "حضور"
Me.Requery
Me.TimerInterval = 3000
Me.id = ""
Me.id.SetFocus
rs.Update
Exit Sub
End If
End If
End Sub

وهذه هي النتيجة الرائعة :

Private Sub id_AfterUpdate()
    Dim EmpUserid As Variant
    Dim mylevl As Boolean
    Dim EmpFatrah As Variant
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim waitTime As Integer
    Dim AdTim As Date
    Dim empName As String ' Declare empName

    EmpUserid = Me.id

    ' Corrected logic for mylevl to check for user existence
    mylevl = Not IsNull(DLookup("Emp_user", "tblEmpNames", "Emp_user='" & EmpUserid & "'"))
    EmpFatrah = Nz(DLookup("fatrah", "tblEmpNames", "Emp_user='" & EmpUserid & "'"), 0)

    If mylevl = False Then
        Beep
        Me.LabelH.Caption = "خطأ!! .. الادخال غير صحيح"
        Me.TimerInterval = 3000
        Me.id = ""
        Me.id.SetFocus
        Exit Sub
    End If

    ' Lookup empName once after confirming user existence
    empName = Nz(DLookup("Emp_Name", "tblEmpNames", "Emp_user='" & EmpUserid & "'"), "")

    strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " & vbCrLf & _
             "FROM tblCheckINOut " & vbCrLf & _
             "WHERE (((tblCheckINOut.EmpUser)='" & EmpUserid & "')) " & vbCrLf & _
             "ORDER BY tblCheckINOut.id DESC;"
    Set rs = CurrentDb.OpenRecordset(strSql)

    If rs.RecordCount = 0 Then
        rs.AddNew
        rs!EmpUser = EmpUserid
        rs!chekInOut = Now()
        rs!chkio = "I"
        rs!ftra_id = EmpFatrah
        Me.txtnm = empName
        Me.LabelH.Caption = "حضور"
        Me.Requery
        Me.TimerInterval = 3000
        Me.id = ""
        Me.id.SetFocus
        rs.Update
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If

    waitTime = Nz(DLookup("waitBtween", "tblTimeCtrl"), 0)
    AdTim = DateAdd("n", waitTime, rs!chekInOut)

    If Now() < AdTim Then
        Me.id.SetFocus
        Beep
        Me.LabelH.Caption = "توقيع مكرر !! انتظر قليلا ..."
        Me.id = ""
        Me.TimerInterval = 3000
        Me.id.SetFocus
        rs.Close
        Set rs = Nothing
        Exit Sub
    Else
        If rs!chkio = "I" Then
            rs.AddNew
            rs!EmpUser = EmpUserid
            rs!chekInOut = Now()
            rs!chkio = "O"
            rs!ftra_id = EmpFatrah
            Me.txtnm = empName
            Me.LabelH.Caption = "انصراف"
            Me.Requery
            Me.id = ""
            Me.TimerInterval = 3000
            Me.id.SetFocus
            rs.Update
            rs.Close
            Set rs = Nothing
            Exit Sub
        ElseIf rs!chkio = "O" Then
            rs.AddNew
            rs!EmpUser = EmpUserid
            rs!chekInOut = Now()
            rs!chkio = "I"
            rs!ftra_id = EmpFatrah
            Me.txtnm = empName
            Me.LabelH.Caption = "حضور"
            Me.Requery
            Me.TimerInterval = 3000
            Me.id = ""
            Me.id.SetFocus
            rs.Update
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
    End If
End Sub

 

صحيح هو اضاف لي هذا المتغير :

 

 Dim EmpUserid As Variant

ولكن هذا المتغير تم الاعلان عنه في الوحدة النمطية كمتغير عام

وانا لا الومه لانه لا يعلم وليس له الا الظاهر  ☺️

[Lamyaa]

الأداة رائعة

 

ولكن اشتغلت معي مرة واحدة وبعدها يظهر لي الخطأ: حدث خطأ أثناء الاتصال بخدمة الذكاء الاصطناعي

تم تعديل منذ 29 دقائق بواسطه Lamyaa