اذهب الي المحتوي
أوفيسنا

ابو جودي

أوفيسنا
  • Posts

    6,503
  • تاريخ الانضمام

  • Days Won

    167

Community Answers

  1. ابو جودي's post in إدراج صنف من نموذج إلى نموذج ثاني ثم الانتقال إلى السطر التالى فى النموذج الثاني تلقائيا مع ترك النموذج الأول مفتوح لإدراج أصناف أخري was marked as the answer   
    اتفضل  
    بس نصيحة لوجه الله لا تستخدم الأحرف العربية فى تسمية الحقول والكائنات والعناصر وكذلك لا تحاول استخدامها فى محرر الأكواد لسببين 
    1- عند استخدامها تتداخل الأكواد وقد تعجز عن التعديل عليها مستقبلا وقد تعجز اساسا عن فهم الكود وبناء الجمل من النظر الى الترتيب المعكوس بسبب الأحرف العربية كما يحدث فى دوال المجال على سبيل المثال وليس الحصر
    2- عند محاولة استخدام قاعدة البيانات فى ويندوز لم يتم اعداد اللغة الاقليمية الى اللغة العربية له يحدث خطأ ولا يتم تنفيذ الاوامر البرمجية وبالتالى لن تعمل القاعدة وقد لا تعرف من الرسالة أن اللغة العربية هى المشكلة
     
    ملاحظة وضعت عدد اتنين زر امر لزيادة ونقصان الكمية افضل من زيادتها بالضغط على اسم الصنف كما تريد
    ولكن ان اردت ذلك لا يوجد عندى ادنى مشكلة
    أنا وضعت أفضل تصور من وجهة نظرى آخذا فى الاعتبار كل ما خطر على بالى لإضفاء المرونة واليسر فى التعامل 

    واخيرا اتفضل قاعدتك بعد التعديل ان شاء الله تجد ما تريد 
     
    مثال إدراج الأصناف فى الفاتورة بشروط_( v 2 ).accdb
  2. ابو جودي's post in حجز متغير لقاعدة بيانات من قاعدة بيانات أخري was marked as the answer   
    طيب وبما انك وصلت للحل
    لتعم الفائدة
    Dim db As DAO.Database Dim rst As DAO.Recordset ' Open the database Set db = DBEngine.OpenDatabase(".\officenaDB.mdb") ' Open the Recordset Set rst = db.OpenRecordset ("SELECT * FROM Customers WHERE CustomerId = 'officena'", dbOpenDynaset)  
  3. ابو جودي's post in كيفية يمكن ترتيب الطلبة was marked as the answer   
    وهذه قاعدتك بعد التعديل 
     
    ترتيب الطلبة.zip
  4. ابو جودي's post in كيف يتم اظهار مربعات الإختيار بنعم فقط في التقرير was marked as the answer   
    t11 (1).accdb
  5. ابو جودي's post in مشكلة عدم عرض الصور was marked as the answer   
    جرب الطريقة دى 
    Photo.zip
  6. ابو جودي's post in نسخ المرفق ووضعه في ملف مع البرنامج was marked as the answer   
    الشكر لله 
    اتفضل 
     
    نسخه من مرفق (3).accdb
  7. ابو جودي's post in حماية : إخفاء كائنات قاعدة البيانات داخل محرر الأكواد was marked as the answer   
    طبعا لا 
  8. ابو جودي's post in Combobox بحث باكثر من معيار was marked as the answer   
    اتفضل 
     
    ser2.rar
  9. ابو جودي's post in برنامج لانشاء كلمات سر was marked as the answer   
    وهذا تطبيق مبدئى 
    GeneratorPassword.accdb
  10. ابو جودي's post in الفاتوره الالكترونيه was marked as the answer   
    ان شاء الله الحل هنا ان اردت وهو إهداء لمن يريد 
     
    وهنا كان موضوع البحث والنقاش
     
  11. ابو جودي's post in استفسار عن: اغلاق قاعدة بيانات مع اغلاق النموذج was marked as the answer   
    استخدم الكود الاتى 
    Private Sub Form_Close() On Error GoTo QuitApp_Err DoCmd.Quit acSave QuitApp_Exit: Exit Sub QuitApp_Err: MsgBox Error$ Resume QuitApp_Exit End Sub  
  12. ابو جودي's post in مدة عمل الموظف في المؤسسة was marked as the answer   
    السلام عليكم ورحمة الله وبركاته
    مشاركة مع اساتذتى الافاضل 
    كنا قد تطرقنا الى موضو ع شبيه لذلك وهذا >---->>   رابط الموضوع 
     
    واليكم المرفق بتطبيق الكود من الموضوع الذى تم التنويه عنه بعاليه والشرح تفصيلا موضوح  بالموضوع
     
    مدة عمل الموظف.accdb
  13. ابو جودي's post in سؤال و جواب ؟ was marked as the answer   
    طيب وليه كل ده 
    اضف الحقول الاتية فى الجدول الرئيسي
    منقطع - مفصول - موقوف 
    على ان تكون من النوع  Yes/No
    منقطع = yes
    مفصول = yes
    موقوف = yes
    وسوى استعلام ومرر اليه القيمى المعلمه ليقوم بعمل الفلتر تبعا للحالة الممرة 
    او الابسط
    سوى عدد استعلامات تبعا لعدد الحالات وفى المعيار اختر حقل الفتر   yes تبعا لكل حالة 
    الموضوع ابسط من البساطة
  14. ابو جودي's post in سوال اختيار الطابعه was marked as the answer   
    اتفضل يا سيدى 
     
    SetMultiPrinter.accdb
  15. ابو جودي's post in تعديل استعلام ليقوم بتنفيذ كود استخراج تقرير was marked as the answer   
    جزاكم الله خيرا على دعواتكم الطيبة اسأل الله تعالى ان يرزقكم فضلها
    الحمد لله الذى تتم بنعمته الصالحات 
  16. ابو جودي's post in التأكد من وجود الفولد فى الاستعلام was marked as the answer   
    لا يمكن عمل ذلك من الاستعلام بطريقة مباشرة 
    ولكن يمكن اذا كان الكود الاتى فى وحدة نمطية  لتتمكن استدعاء الكود فى زوايا التطبيق المختلفة حتى لو فى استعلام
    الروتين المستخدم فى الوخدة النمطية :
    Public Function CheckFolder(strFolderPath As String) As Boolean Dim strIsFolder As String strFolderPath = strFolderPath strIsFolder = Dir(strFolderPath, vbDirectory) If strIsFolder = "" Then CheckFolder = False Else: CheckFolder = True End Function الان فى الاستعلام وحسب ما اشرتم فى رأس الموضوع اضف فى حقل جديد السطر الاتى 
    CheckFolder([folderName])
    مع العلم ان حقل الـ  folderName  فى الاستعلام لابد وان يحتوى على المسار كاملا للمجلد
     
  17. ابو جودي's post in هل يمكن استعراض السجلات بمسج بوكس تلقائيا *_^ was marked as the answer   
    اتفضل يا سيدى  احلام معاليك اوامر يا باش مهندس @Moosak 
    اى خدمه 
    يارب تنبسط بس 
     
     تعتمد الفكرة على وضع الروتين الاتى فى وحدة نمطية
    Public opt As Integer Public Function MesgBox(ByVal msgText As String, _ Optional ByVal TimeInSeconds As Integer, _ Optional ByVal intButtons = vbDefaultButton1, _ Optional TitleText As String = "WScript") As Integer On Error GoTo MesgBox_Err Dim winShell As Object Set winShell = CreateObject("WScript.Shell") MesgBox = winShell.PopUp(msgText, TimeInSeconds, TitleText, intButtons) MesgBox_Exit: Exit Function MesgBox_Err: winShell.PopUp Err & " : " & Err.Description, 0, "MesgBox()", vbCritical Resume MesgBox_Exit End Function  ويتم استدعاء الورتين من خلال 
    opt = MesgBox(Me.n & vbCr & vbCr & " Please wait . . .", 1, vbInformation, "Info") حيث ان بناء الكود كالاتى 
    'Syntax: opt = MesgBox(msgTxt,intSeconds,Buttons+Icon+DefaultButton,"Title")  
     
    aa V2.accdb
  18. ابو جودي's post in أريد تمرير اسم التقرير برمجيا (كمتغير) was marked as the answer   
    اولا بارك الله فى عمرك وعلمك وعملك وجزاكم كل خير 
    ثانيا انا اقل طويلب علم ولست مبرمجا على الاطلاق مجرد هاو
    ثالثا كنت ابلور فكرة من الامس شبيه بفكرة حضرتك
    استخدمت الروتين الاتى فى وحدة نمطية
    Function OpenReport(ByRef rptName As String, ByRef qryName As String) On Error GoTo ErrorHandler DoCmd.OpenReport rptName, acViewPreview, , , , qryName procDone: Exit Function ErrorHandler: MsgBox$ Err.Number & ": " & Err.Description Resume procDone End Function على ان يتم استدعاءه بالسطر الاتى 
    OpenReport("rpt2", "Query2") نفس فكرة حضرتك
    طبعا بسبب الغموض وعدم التوضيح الكافى كنت فى انتظار اضافة المرفق 
    Chang Record Sources Report VBA(V3).mdb
  19. ابو جودي's post in طريقه تكرار سجل حسب قيمه معينه was marked as the answer   
    بسيطة ان شاء الله
    اتفضل يا سيدى 
    New Microsoft Access Database (2-1).accdb
  20. ابو جودي's post in fullName field was marked as the answer   
    لا احنا كده جمعنا اربع روس فى الحلال 
  21. ابو جودي's post in خطأ فى استعلام الرقم القومى was marked as the answer   
    اتفضل يا سيدى 
    لا تنسى وضع افضل اجابة 
     
    وهذه هى الاكواد المستخدمة 
    Dim CalcAge As String Public Function IDData(IDNumber As Variant, Optional stype As Integer = 1) As Variant If IsNull(IDNumber) Or IDNumber = "" Or IDNumber = "" Or IDNumber = Empty Or IDNumber = vbNullString Or Len(IDNumber) = 0 Then IDData = "" Exit Function ElseIf Len(IDNumber) < 14 Then IDData = ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1608") & ChrW("1605") & ChrW("1609") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & ChrW("1610") & ChrW("1581") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1571") & ChrW("1589") & ChrW("1594") & ChrW("1585") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("49") & ChrW("52") & ChrW("32") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("41") Exit Function ElseIf Len(IDNumber) > 14 Then IDData = ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1608") & ChrW("1605") & ChrW("1609") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & ChrW("1610") & ChrW("1581") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1571") & ChrW("1603") & ChrW("1576") & ChrW("1585") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("49") & ChrW("52") & ChrW("32") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("41") Exit Function ElseIf Not IsNumeric(IDNumber) Then IDData = ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1608") & ChrW("1605") & ChrW("1609") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & ChrW("1610") & ChrW("1581") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1604") & ChrW("1575") & ChrW("1576") & ChrW("1583") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1573") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1575") & ChrW("1605") & ChrW("32") & ChrW("1571") & ChrW("1585") & ChrW("1602") & ChrW("1575") & ChrW("1605") & ChrW("32") & ChrW("1601") & ChrW("1602") & ChrW("1591") & ChrW("32") & ChrW("41") Exit Function ElseIf Not IsDate(Format(IIf(Left(IDNumber, 1) = 3, Mid(IDNumber, 2, 2) + 2000, Mid(IDNumber, 2, 2) + 1900) & "/" & Mid(IDNumber, 4, 2) & "/" & Mid(IDNumber, 6, 2), "yyyy/mm/dd")) Then IDData = ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1608") & ChrW("1605") & ChrW("1609") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & ChrW("1610") & ChrW("1581") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1578") & ChrW("1575") & ChrW("1585") & ChrW("1610") & ChrW("1582") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1610") & ChrW("1604") & ChrW("1575") & ChrW("1583") & ChrW("32") & ChrW("41") Exit Function Else If stype = 1 Then Dim DateOfBirth As Date: DateOfBirth = Format(IIf(Left(IDNumber, 1) = 3, Mid(IDNumber, 2, 2) + 2000, Mid(IDNumber, 2, 2) + 1900) & "/" & Mid(IDNumber, 4, 2) & "/" & Mid(IDNumber, 6, 2), "yyyy/mm/dd") IDData = DateOfBirth Dim strYear As String: strYear = ChrW("1587") & ChrW("1606") & ChrW("1607") Dim strMnth As String: strMnth = ChrW("1588") & ChrW("1607") & ChrW("1585") Dim strDy As String: strDy = ChrW("1610") & ChrW("1608") & ChrW("1605") CalcAge = CalcAgeY(DateOfBirth, Date) & " " & strYear & " " & "," & CalcAgeM(DateOfBirth, Date) & " " & strMnth & " " & "," & CalcAgeD(DateOfBirth, Date) & " " & strDy ElseIf stype = 2 Then Dim strRegionCode As String: strRegionCode = Mid(IDNumber, 8, 2) Select Case strRegionCode Case Is = "01": IDData = ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1575") & ChrW("1607") & ChrW("1585") & ChrW("1577") Case Is = "02": IDData = ChrW("1575") & ChrW("1604") & ChrW("1573") & ChrW("1587") & ChrW("1603") & ChrW("1606") & ChrW("1583") & ChrW("1585") & ChrW("1610") & ChrW("1577") Case Is = "03": IDData = ChrW("1576") & ChrW("1608") & ChrW("1585") & ChrW("1587") & ChrW("1593") & ChrW("1610") & ChrW("1583") Case Is = "04": IDData = ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1608") & ChrW("1610") & ChrW("1587") Case Is = "11": IDData = ChrW("1583") & ChrW("1605") & ChrW("1610") & ChrW("1575") & ChrW("1591") Case Is = "12": IDData = ChrW("1575") & ChrW("1604") & ChrW("1583") & ChrW("1602") & ChrW("1607") & ChrW("1604") & ChrW("1610") & ChrW("1577") Case Is = "13": IDData = ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1585") & ChrW("1602") & ChrW("1610") & ChrW("1577") Case Is = "14": IDData = ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1604") & ChrW("1610") & ChrW("1608") & ChrW("1576") & ChrW("1610") & ChrW("1577") Case Is = "15": IDData = ChrW("1603") & ChrW("1601") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1610") & ChrW("1582") Case Is = "16": IDData = ChrW("1575") & ChrW("1604") & ChrW("1594") & ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1577") Case Is = "17": IDData = ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1610") & ChrW("1577") Case Is = "18": IDData = ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1581") & ChrW("1610") & ChrW("1585") & ChrW("1577") Case Is = "19": IDData = ChrW("1575") & ChrW("1604") & ChrW("1573") & ChrW("1587") & ChrW("1605") & ChrW("1575") & ChrW("1593") & ChrW("1610") & ChrW("1604") & ChrW("1610") & ChrW("1577") Case Is = "21": IDData = ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1610") & ChrW("1586") & ChrW("1577") Case Is = "22": IDData = ChrW("1576") & ChrW("1606") & ChrW("1610") & ChrW("32") & ChrW("1587") & ChrW("1608") & ChrW("1610") & ChrW("1601") Case Is = "23": IDData = ChrW("1575") & ChrW("1604") & ChrW("1601") & ChrW("1610") & ChrW("1608") & ChrW("1605") Case Is = "24": IDData = ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1606") & ChrW("1610") & ChrW("1575") Case Is = "25": IDData = ChrW("1571") & ChrW("1587") & ChrW("1610") & ChrW("1608") & ChrW("1591") Case Is = "26": IDData = ChrW("1587") & ChrW("1608") & ChrW("1607") & ChrW("1575") & ChrW("1580") Case Is = "27": IDData = ChrW("1602") & ChrW("1606") & ChrW("1575") Case Is = "28": IDData = ChrW("1571") & ChrW("1587") & ChrW("1608") & ChrW("1575") & ChrW("1606") Case Is = "29": IDData = ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1602") & ChrW("1589") & ChrW("1585") Case Is = "31": IDData = ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1581") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1581") & ChrW("1605") & ChrW("1585") Case Is = "32": IDData = ChrW("1575") & ChrW("1604") & ChrW("1608") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1583") & ChrW("1610") & ChrW("1583") Case Is = "33": IDData = ChrW("1605") & ChrW("1591") & ChrW("1585") & ChrW("1608") & ChrW("1581") Case Is = "34": IDData = ChrW("1588") & ChrW("1605") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1587") & ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1569") Case Is = "35": IDData = ChrW("1580") & ChrW("1606") & ChrW("1608") & ChrW("1576") & ChrW("32") & ChrW("1587") & ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1569") Case Is = "88": IDData = ChrW("1605") & ChrW("1608") & ChrW("1575") & ChrW("1604") & ChrW("1610") & ChrW("1583") & ChrW("32") & ChrW("1582") & ChrW("1575") & ChrW("1585") & ChrW("1580") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1605") & ChrW("1607") & ChrW("1608") & ChrW("1585") & ChrW("1610") & ChrW("1577") Case Else: IDData = ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1608") & ChrW("1605") & ChrW("1609") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & ChrW("1610") & ChrW("1581") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1603") & ChrW("1608") & ChrW("1583") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1581") & ChrW("1575") & ChrW("1601") & ChrW("1592") & ChrW("1577") & ChrW("32") & ChrW("41") End Select ElseIf stype = 3 Then Dim GenderCode As Long: GenderCode = Mid(IDNumber, 13, 1) Select Case GenderCode Case Is = 1, 3, 5, 7, 9: IDData = ChrW("1584") & ChrW("1603") & ChrW("1585") Case Is = 0, 2, 4, 6, 8: IDData = ChrW("1571") & ChrW("1606") & ChrW("1579") & ChrW("1609") Case Else: IDData = "" End Select ElseIf stype = 4 Then IDData = CalcAge End If End If End Function Function CalcAgeY(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeY = vYears End Function Function CalcAgeM(vDate1 As Date, vdate2 As Date) Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeM = vMonths End Function Function CalcAgeD(vDate1 As Date, vdate2 As Date) As String Dim vYears As Integer, vMonths As Integer, vDays As Integer vMonths = DateDiff("m", vDate1, vdate2) vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) If Day(vDate1) = 31 Then vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) - 1 If vDays < 0 Then vMonths = vMonths - 1 vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2) End If vYears = vMonths \ 12 vMonths = vMonths Mod 12 CalcAgeD = vDays End Function على اعتبار أن xxx = الرقم القومى
    IDData(xxx, 1)   او    IDData(xxx)   >>--->  تاريخ الميلاد
    IDData(xxx, 2)                             >>--->  محافظة الميلاد
    IDData(xxx, 3)                             >>--->  النوع
    IDData(xxx, 4)                             >>--->  حساب العمر
    قاعدة بيانات موظفين - (3).accdb
  22. ابو جودي's post in اريد استخدام استعلام لاضهار قيمة مكررة بين حقلين او ثلاثة حقول was marked as the answer   
    طيب بعد التمعن فى الفوكيرة اللى فاتت لابد من التطبيق بتلك الالية بعدد  7 استعلامات 
    الاستعلام النهائى والذى يظهر القيم المكررة هو qryUnionMob 
    3or2Colume (2).accdb
  23. ابو جودي's post in هل بالامكان انشاء تقرير على الاكساس بهذه الطريقة was marked as the answer   
    نعم يمكن ذلك وبكل سهولة جدا جدا جدا 
  24. ابو جودي's post in اختيار الكلمة الاولى فقط من مربع نص was marked as the answer   
    وهذه فكرتى المتواضعة من خلال وظيفة داخل وحدة نمطية
    Function GoExt(strText As String) Dim strExtractionWord As String: strExtractionWord = Nz(Left([strText], InStr([strText] & "", " ") - 1), strText) Select Case strExtractionWord Case Is = strText: GoExt = strText Case Is = "مصر": GoExt = "جهورية" & " " & strText Case Is = "العربية": GoExt = "المملكة" & " " & strText Case Is = "المتحدة": GoExt = "الولايات" & " " & strText Case Is = "الاردنية": GoExt = "المملكة العربية" & " " & strText End Select End Function يتم استدعاء الوظيفة من خلال
    GoExt([text1]) ولا انصح بكتابة الأحرف العربية داخل محرر الاكود
    ممكن نستخدم اليونيكود او جدول واستخدام DLookup
     ويكون التطبيق كالاتى 
     
    db2_text.mdb
  25. ابو جودي's post in عدم تمكين زر اغلاق الخاص بالاكسس was marked as the answer   
    ضع الوظيفة الاتية فى وحدة نمطية
     
    Option Compare Database Option Explicit #If VBA7 Or Win64 Then Public Declare PtrSafe Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal flag As Long) As Long Public Declare PtrSafe Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long #Else Public Declare Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long Public Declare Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hWnd As Long, ByVal flag As Long) As Long #End If Const MF_BYCOMMAND = &H0& Const MF_DISABLED = &H2& Const MF_ENABLED = &H0& Const MF_GRAYED = &H1& Const SC_CLOSE = &HF060& Const SWP_NOSIZE = &H1 Const SWP_NOZORDER = &H4 Const SWP_NOMOVE = &H2 Const SWP_FRAMECHANGED = &H20 Const WS_MINIMIZEBOX = &H20000 Const WS_MAXIMIZEBOX = &H10000 Const WS_SYSMENU = &H80000 Public Function EnableDisableControlBoxX(bEnable As Boolean, Optional ByVal lhWndTarget As Long = 0) As Long On Error GoTo Err_EnableDisableControlBoxX Dim lhWndMenu As Long Dim lReturnVal As Long Dim lAction As Long lhWndMenu = apiGetSystemMenu(IIf(lhWndTarget = 0, Application.hWndAccessApp, lhWndTarget), False) If lhWndMenu <> 0 Then If bEnable Then lAction = MF_BYCOMMAND Or MF_ENABLED Else lAction = MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED End If lReturnVal = apiEnableMenuItem(lhWndMenu, SC_CLOSE, lAction) End If EnableDisableControlBoxX = lReturnVal Exit_EnableDisableControlBoxX: Exit Function Err_EnableDisableControlBoxX: MsgBox "Error:" & Err.Number & vbCrLf & "Description: " & Err.Description Resume Exit_EnableDisableControlBoxX End Function  
     ويمكنك عدم تفعيل زر الاغلاق من خلال 
    EnableDisableControlBoxX False  
    ويمكنك الرجوع للوضع الاصلى بإعادة فاعلية زر الاغلاق من 
    EnableDisableControlBoxX True  
×
×
  • اضف...

Important Information