اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ابو جودي

أوفيسنا
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    6997

  • تاريخ الانضمام

  • Days Won

    202

 نوع المحتوي 

كل منشورات العضو ابو جودي

  1. ابو جودي
    اتغضل فى المرفق الطريقتين التقليدية من خلال زر امر لكل ترتيب نريد عمله والطريقة الذكية كما اسميتها من خلال نقرتين على العنوان لكل حقل من خلال موديول والشرح هنا يا افندم DATA1041-5 (6).mdb
  2. ابو جودي
    احبكم فى الله لطفا ما اسم النموذج كما سميته حضرتك فى المرفق الله يرضى عليك وحاول الله يرضى عليك بعد ذلك وضه مرفق لا يحتوى على تطبيق كامل فقط مرفق بسيط يتم الاجابة عليه بسهوله
  3. ابو جودي
    لطفا اين تريد وضع كود الترتيب فى نموذج
  4. ابو جودي
    هات مرفق
  5. ابو جودي
    لا يمكن ذلك لان الكود يدرج القيم تبعا لنوع الحقل حتما سوف يحدث خطأ فى تلك الحالة ولن يستكمل ادارج البيانات ..لم اجرب ولكن ذلك ما سوف يحدث وبالفعل تلك نتيجة التجربة لم يتم الاستمرار بملئ بيانات الحقول وتم اجهاض العملية نتيجة خطأ وهو اضافة نوع بيانات مختلف عن النوع المخصص للحقل فى الجدول
  6. ابو جودي
    عندى استفسار من فضلك استاذى الجليل ومعلمى القدير و والدى الحبيب استاذ @jjafferr بخصوص الية ملئ عدة حقول كثرت او قلت فى جدول ما من خلال روتين عام تلك الفكرة هى ما درات بخلدى ما رأيكم بها استاذى ؟! هل هى مرنة ؟ هل قد نواجه بسببها مشاكل مستقبلا ؟! هل هناك طريقة او فكرة افضل من تلك
  7. ابو جودي
    هلا والله وميت مليون هلا استاذى الجليل ومعلمى القدير و والدى الحبيب استاذ @jjafferr والله فعلا انا عن نفسي احس بالانس وبالامان بوجودكم فى المنتدى لانه بفضل الله تعالى ثم انتم لكل مشكلة حل أدامكم الله روح طيبة تسكن القلوب .. ووجه باسم ترتاح له العيون .. ونفس مطمئنة تمتلك النفوس .. وأسأله عز وجل أن يعطيكم من عطــاياه ويمنحكم عفوه ورضاه ويغفر لكم من عمركم ما مضى ويقدر لكم الخير فيما أتى .. وأن يجعل السعادة رفيقتكم في الدنيا والآخره.. اللهم آمين.
  8. ابو جودي
    سؤال عن اضاقة قيم من نموذج غير منضم الى حقول فى جدول من خلال Recordset.AddNew الطريقة التقليدية اعلمها ولكن احاول عمل Function يسهل العملية وتدور فكرتى باستدعاء الكود كالاتى Call ApendData("Table Name", "Field Name On Table", Object Name On Form) وهذه الاكواد التى استخدمتها فى الموديول Sub ApendData(ByVal strTableName As String, ByVal strFieldName As String, ByVal strObjectName As String) Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb() Set rs = CurrentDb().OpenRecordset(strTableName) rs.AddNew rs.Fields(strFieldName) = "" & strObjectName & "" rs.Update rs.Close End Sub ولكن المشكلة انه تم اضافة البيانات فى اكصر من سجل حسبب عدد الحقول وبيانات كل حقل قى سجل المفروض ان يتم تسجيل كافة بيانات الحقول فى سدل واحد كيف يمكن عمل ذلك المرفق ApendDataByRecordset.mdb
  9. ابو جودي
    التعديل حسب فهمى لطلبك لو تقصد غير ذلك انذاك سوف تحتاج ان تقدم تفسيرا مفصلا لطلبك cnbo (1).accdb
  10. ابو جودي
    القيم هنا تأتى من جدول tbl_Cat4 انت فقط محتاج تصمم نموذج مصدر بياناته هذا الجدول tbl_Cat4 ليس الا اما بالنسبة لتلك الجزئية انت فقط تحتاج تصميم نموذج مصدر بياناته الجدول file-1
  11. ابو جودي
    مربع اختيار غير منضم فى نموذج مستمر
  12. ابو جودي
    موديول: كود إضافة قيمة غير موجودة بالقائمة لمربع سرد (Not In List) يتم استدعاء الكود فى الحدث >>------> عند عدم الوجود فى القائمة - NotInList من خلال الكود الاتى مع تغيير tableName باسم الجدول المراد اضاقة القيمة الجديدة اليه وتغيير FieldName باسم الحقل داخل الجدول المراد اضاقة القيمة الجديدة اليه Call CmboNotInList("tableName", "FieldName", NewData, Response) الموديول Public Sub CmboNotInList(ByVal strTableName As String, ByVal strFieldName As String, ByVal strNewData As String, ByRef intResponse As Integer) On Error GoTo Proc_Err Dim sSQL As String Dim sMsg As String intResponse = acDataErrContinue sMsg = """" & strNewData & """ is not in the current list. " & vbCrLf & vbCrLf & "Do you want to add it? " If MsgBox(sMsg, vbYesNo, "Add New Data") <> vbYes Then GoTo Proc_Exit End If sSQL = "INSERT INTO [" & strTableName & "] " & "([" & strFieldName & "])" & " SELECT """ & strNewData & """;" With CurrentDb .Execute sSQL If .RecordsAffected > 0 Then intResponse = acDataErrAdded End If End With Proc_Exit: Exit Sub Proc_Err: MsgBox Err.Description, , "ERROR " & Err.Number & " CmboNotInList" Resume Proc_Exit Resume End Sub مرفق Not In List.mdb
  13. ابو جودي
    موضوع هام جدا جدا جدا يضم بين طياته الدرر الكثيرة تليون نتيجة البحث من موديول بكل سهولة , الفلاتر المتعددة , المرونة فى تصميم كود داخل موديول
  14. ابو جودي
    فكرة اعجبتنى واجب الاحتفاظ بها والعودة اليها متى شئت بسهولة لذلك اضع الكود هنا والمرفق فى كشكولى المتواضع نسخ احتياطى لقاعدة الجدوال تلقائيا عند فى كل مرة يتم فيعا اغلاق القاعدة الامامية الكود داخل المديول وتلميحات الشرح بقدر المستطاع '--25-10-2021-----------------------------------------------' Option Compare Database Option Explicit Function RunSub() Dim dbs As DAO.Database Dim tdf As DAO.TableDef Dim strPathDB As String Dim strNameExtensionDB As String Dim strNameDB As String Dim strExtensionDB As String Dim strBackupPath As String Dim strNewNameBackupDB As String Dim fso As Object Dim Syso As Object Set dbs = CurrentDb() With dbs For Each tdf In .TableDefs 'Is the table a linked table? If tdf.Attributes And dbAttachedODBC Or tdf.Attributes And dbAttachedTable Then With tdf 'Connect property contains path of link strPathDB = .Properties("Connect").Value 'Path of linked database tables strPathDB = Replace(strPathDB, ";DATABASE=", vbNullString) End With End If Next tdf End With 'Backup path directory strBackupPath = CurrentProject.Path & "\Backup\" Set fso = CreateObject("scripting.filesystemobject") 'Create the Backup folder if it does not exist If Not fso.FolderExists(strBackupPath) Then fso.createfolder (strBackupPath) 'Database name with extension strNameExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, "\")) 'Database name without extension strNameDB = Left(strNameExtensionDB, InStrRev(strNameExtensionDB, ".") - 1) 'extension only strExtensionDB = Right(strPathDB, Len(strPathDB) - InStrRev(strPathDB, ".")) 'New name for backup database strNewNameBackupDB = strNameDB & "-Backup-" & Format(Now, "mm-yyyy") & "." & strExtensionDB 'Backup database save path directory strBackupPath = strBackupPath & strNewNameBackupDB DBEngine.Idle 'Copy the backup database to its directory Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile strPathDB, strBackupPath Set Syso = Nothing DoCmd.RunCommand acCmdExit End Function المرفق ملاحظة هامة جدا هذا مثال فقط ينقصه اعادة ربط الجداول المرتبطة من قاعدة الخلفية فقط حتى يعمل النسخ الاحتياطى على اكمل وجه Automatically Backup.zip
  15. ابو جودي
    هلا والله وميت مليون هلا استاذى الجليل ومعلمى القدير و والدى الحبيب استاذ @jjafferr والله فعلا انا عن نفسي احس بالانس وبالامان بوجودكم انتم وباقى اساتذتى العظماء فى المنتدى لانه بفضل الله تعالى ثم انتم لكل مشكلة فى جعبتكم لها حل أدامكم الله روح طيبة تسكن القلوب .. ووجه باسم ترتاح له العيون .. ونفس مطمئنة تمتلك النفوس .. وأسأله عز وجل أن يعطيكم من عطــاياه ويمنحكم عفوه ورضاه ويغفر لكم من عمركم ما مضى ويقدر لكم الخير فيما أتى .. وأن يجعل السعادة رفيقتكم في الدنيا والآخره.. اللهم آمين.
  16. ابو جودي
    جزاكم الله خيـــــــرا اساتذتى العظماء وفكرتى المتواضعة على الطريقة الجعفرية كل الشكر استاذ @jjafferr لان الفكرة اصلا اكتسبتها منكم سابقا والحل الان منكم سيدى نقوم بعمل موديول عام Public Function IconByChk(ByVal strFieldNameA As String, ByVal strFieldNameB As String) IconByChk = CurrentProject.Path & "\ico\" & strFieldNameA & strFieldNameB & ".png" End Function ويتم استدعاءه فى الاستعلام img: IconByChk([completed],[printed]) واخيرا المرفق Show One img.zip
  17. ابو جودي
    جزانا الله واياكم خير الجزاء يعلم الله وانا كذلك واحاول من وقت نشر الموضوع
  18. ابو جودي
    من الناحية المنطقية لا ولكن ربما يوجد حل غير منطقى والله لازلت افكر واحاول وما سبق هو رايى المتواضع وانا اقل طالب علم قد يكون لدى اساتذتنا حلول فلا تيأس وانتظر
  19. ابو جودي
    لا يمكن تحقيق ذلك , والله اعلم
  20. ابو جودي
    احيانا نغير خصائص النموذج Border style لتكون None فى هذه الحالة لا نستطيع تغير مكان النموذج من خلال السحب والافلات بالماوس وحل هذه المشكلة يكمن فى الاتى ننشئ موديول ونضع به الكود الاتى Option Compare Database Option Explicit 'API to move a form with a mouse down event Public Const WM_NCLBUTTONDOWN = &HA1 Public Const HT_CAPTION = &H2 #If VBA7 Then Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, _ ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Public Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As Long #Else Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function ReleaseCapture Lib "user32.dll" () As Long #End If Public Function MovFrm(ByVal F As Form, ByVal X As Single) X = ReleaseCapture() X = SendMessage(F.hWnd, WM_NCLBUTTONDOWN, HT_CAPTION, 0) End Function ونذخب الى النموذج وفى الحدث on Mouse Down لــ FormHeader نضع السطر الاتى Call MovFrm(Me, X) اخيـــــــرا مرفق التطبيق API to move a form.mdb
  21. ابو جودي
    السلام عليكم ورحمة الله وبركاته احيانا تحدث مشكلات عند تنفيذ احد الاجراءات تبعا للكود المستخدم فكرتى المتواضعة فى هذا المرفق 1- تسجيل الاخطاء ليقف المصمم , المطور , المبرمج على مكان الخطأ تحديدا ورقمه لسهولة حل المشكلة 2- تجاوز الاخطاء كما يترائى لـ المصمم , المطور , المبرمج من خلال الأخطاء التى تم تصيدها وتسجيلها بالجدول Write Error Log .mdb
  22. ابو جودي
    المهم انا راجعت الكود مرارا وتكرار وكان هذا حالى وانا اقوم بمراجهة الكود هههه وعنوان الموضوع سؤال عن :مشكلة عند اضافة بيانات من خلال Recordset من موديول
  23. ابو جودي
    هاهاهاهاهاهاهاهاهاها والله لم انتبه اننى اعلنت عنها فى المتغير انها Database وليس Recordset جزاااكم الله خيرا استاذى الجليل @ناقل من البارحة وانا لا اعرف السبب وابحث هنا وهناك
  24. ابو جودي
    للعلم انا حليت المشكلة باستخدام الكود الاتى ... لكن كنت اريد الوقوف على السبب رغم ان نفس الالية بالكود السابق تعمل معى على نفس الجهاز فى قاعدة اخرى 'Set db = CurrentDb() 'Set rs = db.OpenRecordset("tblErrorLog") With CurrentDb.OpenRecordset("tblErrorLog") .AddNew ![FildenameOnTable] = ObjectNameOnForm .Update .Close End With
  25. ابو جودي
    السلام عليكم ورحمة الله تعالى وبركاته فى موديول عام استخدمت هذا الجزء من الكود ولكن للمرة الأولى تحدث هذه المشكلة معى ولا ادرى السبب Dim db As DAO.Database Dim rs As DAO.Database Set db = CurrentDb() Set rs = db.OpenRecordset("tblErrorLog") rs.AddNew
×
×
  • اضف...

Important Information

  I accept