محمد أبوعبدالله

يوليو 22, 2021

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

جرب التعديل التالي

Private Sub DELL_ROW_Click()
On Error Resume Next
If IsNull(Select3) Then
        a2.Visible = True
MsgBox "يجب تمكين الحذف ", vbCritical + vbMsgBoxRight, "تنبيه"
Exit Sub
End If
If Not IsNull(Select3) Then
        a2.Visible = False
End If

DoCmd.SetWarnings False
    DoCmd.RunCommand acCmdDeleteRecord
	DoCmd.Requery
DoCmd.SetWarnings True
End Sub

تحياتي

يوليو 22, 2021

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

تفضل اخي الكريم

=Round([totol];0)

كسر عشري.accdb

تحياتي

يوليو 21, 2021

في ١٩‏/٧‏/٢٠٢١ at 22:39, jjafferr said:

وعلى كل حال ، فنريد متطوع يقوم بتجربة الطريقتين ، ونأخذ توقيت عمل كل طريقة ، مثلا 10 مرات ، ثم نأخذ المعدل 🙂

تفضل يا غالي

التجربة

1 - جدول به 3 حقول يحتوي على بيانات ما يقرب من ربع مليون سجل

2 - كود متنوع يقوم باستعلام الحاق بثلاث طرق

3 - النتائج مبهرة


'1
        CurrentDb.Execute "DELETE * FROM Table3"
        X = Timer
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;"
        DoCmd.SetWarnings True
        XTime = Timer - X
        XTime = Format(XTime, "#0.0####")
        Debug.Print "Time1 " & "==========> " & XTime

'2
        CurrentDb.Execute "DELETE * FROM Table3"
        X = Timer
        CurrentDb.Execute "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;"
        XTime = Timer - X
        XTime = Format(XTime, "#0.0####")
        Debug.Print "Time2 " & "==========> " & XTime

'3
        CurrentDb.Execute "DELETE * FROM Table3"
        X = Timer
        CurrentDb.Execute "Query1"
        XTime = Timer - X
        XTime = Format(XTime, "#0.0####")
        Debug.Print "Time3 " & "==========> " & XTime
'4
        CurrentDb.Execute "DELETE * FROM Table3"
        X = Timer
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim rst As DAO.Recordset

        Set rs = CurrentDb.OpenRecordset("Table1")
        Set rst = CurrentDb.OpenRecordset("Table3")

        For i = 1 To rs.RecordCount
            rst.AddNew
            rst.Fields(0) = rs.Fields(0)
            rst.Fields(1) = rs.Fields(1)
            rst.Fields(2) = rs.Fields(2)
            rst.Update
            rs.MoveNext
        Next

        rs.Close
        Set rs = Nothing
        rst.Close
        Set rst = Nothing

        XTime = Timer - X
        XTime = Format(XTime, "#0.0####")

        Debug.Print "Time4 " & "==========> " & XTime
    Debug.Print "================================"

db9.rar

تحياتي

يوليو 21, 2021

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

غير خاصية POP UP الى NO

93.png.3a1401bd00824e0edd23a42f465355cf.png

data.rar

تحياتي

يوليو 21, 2021

تقبل الله منا منكم صالح الاعمال

وكل عام وانتم الى الله اقرب

تحياتي

يوليو 20, 2021

السلام عليكم

جرب الكود التالي

  Fri_Days = DCount("[HoliDays]", "tblHoliDays", _
                "WeekdayName(weekday([HoliDays]),true)= 'Fri'" & _
                " and [HoliDays] between#" & Format(begdate, "yyyy/mm/dd") & "#and #" & Format(enddate, "yyyy/mm/dd") & "#")
                Debug.Print "Fri_Dats:--->" & Fri_Days
                
'حساب عدد ايام السبت ضمن الاجازة الرسمية بين التاريخين

    sat_Days = DCount("[HoliDays]", "tblHoliDays", _
                "WeekdayName(weekday([HoliDays]),true)= 'Sat'" & _
                " and [HoliDays] between#" & Format(begdate, "yyyy/mm/dd") & "#and #" & Format(enddate, "yyyy/mm/dd") & "#")
                Debug.Print "Fri_Dats:--->" & Fri_Days

Project2.accdb

تحياتي

يوليو 20, 2021

38 دقائق مضت, Ahmed Sary said:

فهل توجد طريقة لكسر حماية الباسوورد ؟

نعم يوجد برامج كثيرة علماً انه لا يسمح بتداول مثل هذه البرامج في المنتدى

والافضل تحويلها الى accde وبهذه الطريقة لا يمكن عرض الاكواد نهائياً

تحياتي

يوليو 20, 2021

3 دقائق مضت, أحمد العيسى said:

لكن وجدت أن الأكواد تم حجب رؤيتها عن طريق باسورد

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

تحياتي

يوليو 20, 2021

4 دقائق مضت, أحمد العيسى said:

فإذا كان الملف "Runtime" كيف يمكن رؤية أكواده ؟

لا يتم عرض الاكواد اذا كان امتداد الملف accdr

اخي الكريم اذا تم اعادة تسمية امتداد الملف accdr

فلن يتم تفعيل عمل الشيفت

لن يتم عرض جزء التنقل

لن يتم عرض عناصر قاعدة البيانات ( جداول - استعلامات - نماذج ... الخ )

لمزيد من المعلومات انظر الرابط التالي

https://support.microsoft.com/ar-sa/office/نشر-تطبيق-access-7bb4f2ba-30ee-458c-a673-102dc34bf14f

تحياتي

يوليو 20, 2021

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

تكون قاعدة البيانات الاصلية في اكسيس 2007 وما فوق بصيغة accdb

وبعد الانتهاء من البرنامج وقبل تسليمه للعميل يتم تحويل قاعدة البيانات الى accde

اما accdr فهو عبارة عن اعادة تسمية امتداد الملف ولا تؤثر على عمله مطلقاً

ولكن صيغة accdb و accde يمكن تعطيل الشيفت ورؤية الجداول بعكس accdr فهو يعتبر Runtime

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

تحياتي

يوليو 20, 2021

نعم اخي الكريم

الكود الصحيح يكون

DSum("[Days]", "tblVacation", "[EmpCode]=" & Me.CbEmpNo)

تحياتي

يوليو 20, 2021

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

3 ساعات مضت, عمر ضاحى said:

وكل عام وانتم بخير

وعيد اضحي مبارك عليكم

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

وانت بخير وجميع الامة الاسلامية

جرب التعديل التالي

total = DSum("[Days]", tblVacation, "[EmpCode]="& CbEmpNo)

تحياتي

يوليو 18, 2021

6 ساعات مضت, طاهر الوليدي said:

ماطلبته هو نموذج نفس النموذج الي في الصورة بكل التفاصيل نسخ لصق مفتوح الكود او المصدر

تفضل اخي الكريم

db11.accdb

تحياتي

يوليو 18, 2021

السلام عليكم

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

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

تحياتي

يوليو 17, 2021

السلام عليكم

جرب التعديل التالي

Private Sub رقم_اللوحة_Click()
        X1 = Nz(DLookup("[الحروف] & '|' & [المصنع] & '|' & [الشاسيه] & '|' & [نوع_المعدة] & '|' & [المالك] & '|' & [المشروع] & '|' & [شركة_التأمين] & '|' & [انتهاء_الاستمارة] & '|' & [المالك]", "المعدات", "[رقم _اللوحة]=" & Me.رقم_اللوحة), "|||||||||")
        
        X3 = Split(X1, "|")
                                         
        Me.الحروف = X3(0)
        Me.المصنع = X3(1)
        Me.الشاسيه = X3(2)
        Me.نوع_المعدة = X3(3)
        Me.المالك = X3(4)
        Me.المشروع = X3(5)
        Me.شركة_التأمين = X3(6)
        Me.انتهاء_الاستمارة = X3(7)
        Me.المالك = X3(8)
        
End Sub

تحياتي

يوليو 17, 2021

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

ضع الامر التالي في زر امر

DoCmd.RunCommand acCmdFind

تحياتي

يوليو 16, 2021

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

11 دقائق مضت, أبو العقاب said:

أريد عند الطباعة يطبع لي السجلات المكتوبة فقط في النموذج

ضع معيار في حقل الرقم

is not null

تحياتي

يوليو 16, 2021

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

تفضل اخي الكريم

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

تحياتي

يوليو 14, 2021

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

استخدم استعلام تحديث بالشكل التالي

UPDATE [Table] SET [Table].Country = [ادخل كلمة لتحديث البيانات];

examp.accdb

تحياتي

يوليو 14, 2021

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

تفضل اخي الكريم

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

On Error Resume Next
If IsNull(ToDate) Or IsNull(FromDate) Or IsNull(EndYaer) Then
MsgBox "íÌÈ ÇÎÊíÇÑ ÇáÝÊÑÉ æ ÇáÓäÉ ÇáãÇáíÉ ", vbCritical + vbMsgBoxRight, "ÊäÈíå"
Exit Sub
End If
    Dim varFilter As Variant
    varFilter = Null
     
       If Not IsNull(Me.Accounts) Then
          varFilter = (varFilter) & "[Account] LIKE '" & Me.Accounts & "'"
       End If
      
       If Not IsNull(Me.Customers) Then
        varFilter = (varFilter + " AND ") & "[Customer_ID] LIKE '" & Me.Customers & "'"
       End If
       
       If Not IsNull(Me.ToDate) Then
        varFilter = (varFilter + " AND ") & "[Registration_Date] Between " & DateFormat(Me.FromDate) & " And " & DateFormat(Me.ToDate)
       End If
       
         If Not IsNull(Me.Registration_document_Number) Then
        varFilter = (varFilter + " AND ") & "[Registration_document_Number] LIKE '" & Me.Registration_document_Number & "'"
        End If
         If Not IsNull(Me.EndYaer) Then
        varFilter = (varFilter + " AND ") & "[EndYaer] = " & Me.EndYaer
        End If
        
        
        DoCmd.OpenReport "Report1", acViewPreview, , varFilter

الدائن-المدين.zip

تحياتي

يوليو 13, 2021

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

4 ساعات مضت, AliAli47 said:

لدي قاعدة بيانات back end مشفر بكلمة سر

هل تقصد تشفير vba ؟

أم قاعدة البيانات نفسها بحيث تظهر معك هذه الرسالة عند الفتح ؟

15.jpg.577a0004f9bf99b332d2880763d6235e.jpg

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

تحياتي

يوليو 13, 2021

بالتأكيد اذا كان عدد السجلات كبير سيكون هناك ضريبة للتشفير 🙂

تحياتي

يوليو 12, 2021

المشكلة في كود التشفير نفسه

تفضل اخي الكريم هذا كود لتشفير وفك تشفير البيانات اسرع من المستخدم

للتشفير

Public Function Encrypt(StringToEncrypt As String, Optional AlphaEncoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim Char As String
    Encrypt = ""
    
    For i = 1 To Len(StringToEncrypt)
        Char = Asc(Mid(StringToEncrypt, i, 1))
        Encrypt = Encrypt & Len(Char) & Char
    Next i
    
    If AlphaEncoding Then
    
        StringToEncrypt = Encrypt
        Encrypt = ""
        
        For i = 1 To Len(StringToEncrypt)
            Encrypt = Encrypt & Chr(Mid(StringToEncrypt, i, 1))
        Next i
        
    End If
    Exit Function
ErrorHandler:
    Encrypt = "Error"
End Function

لفك التشفير

Public Function Decrypt(StringToDecrypt As String, Optional AlphaDecoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim CharCode As String
    Dim CharPos As Integer
    Dim Char As String
    
    If AlphaDecoding Then
    
        Decrypt = StringToDecrypt
        StringToDecrypt = ""
        
        For i = 1 To Len(Decrypt)
            StringToDecrypt = StringToDecrypt & (Asc(Mid(Decrypt, i, 1)))
        Next i
        
    End If
    
    Decrypt = ""
    
    Do
    
        CharPos = Left(StringToDecrypt, 1)
        StringToDecrypt = Mid(StringToDecrypt, 2)
        CharCode = Left(StringToDecrypt, CharPos)
        StringToDecrypt = Mid(StringToDecrypt, Len(CharCode) + 1)
        Decrypt = Decrypt & Chr(CharCode)
        
    Loop Until StringToDecrypt = ""
    Exit Function
ErrorHandler:
    Decrypt = "Error"
End Function

مثال للتفشير

    DoCmd.RunSQL "UPDATE table12 SET table12.txtbyan = Encrypt([txtbyan])"
    DoCmd.RunSQL "UPDATE table12 SET table12.txtdes = Encrypt([txtdes])"
    DoCmd.RunSQL "UPDATE table12 SET table12.txtallkad = Encrypt([txtallkad])"

مثال لفك التشفير

If Decrypt(DLookup("[pass]", "table12", "[username]='" & names & "'")) = Me.pswrd Then

tashfertable.rar

تحياتي

يوليو 12, 2021

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

لم يتوقف البرنامج ولكن جدول table1 غير موجود

والموجود جدول table12 لو اردنا استخدامه ولكن به مشكلة ايضاً فبه حقول مطلوبة مثل txtbyan و txtdes

جرب الدخول باسم : محمد وكلمة المرور : 123

tashfertable.rar

تحياتي

يوليو 12, 2021

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

الافضل ان تقوم بعمل تصفية للنموذج كالتالي

    Dim myCriteria As String
    
   If IsNull(Me.C) Then
        myCriteria = myCriteria & "("
        myCriteria = myCriteria & "[nmsaf]= '" & Me.a.Value & "'"
        myCriteria = myCriteria & ")"
        'Debug.Print myCriteria
        Me.Form.Filter = myCriteria
        Me.Form.FilterOn = True
   Else
   
        myCriteria = myCriteria & "("
        myCriteria = myCriteria & "[nmsaf]= '" & Me.a.Value & "'"
        myCriteria = myCriteria & " or "
        myCriteria = myCriteria & "[Fsl]= '" & Me.C.Value & "'"
        myCriteria = myCriteria & ")"
        'Debug.Print myCriteria
        Me.Form.Filter = myCriteria
        Me.Form.FilterOn = True
   
   End If

KEN44.accdb

تحياتي

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه محمد أبوعبدالله

Important Information