jjafferr

وعليكم السلام ما لك شغل فيهم ، الكود يعمل كل شئ بنفسه جعفر

أخي الفاضل رجاء توضح وتشرح زيادة ، لاننا ما فاهمين بعض!! 1. انت: حساب مدة عمل الموظف من تاريخ التعيين وحتى تاريخ التقاعد بحيث يأخذ في الاعتبار الاشهر التي بها 30 يوم والاشهر التي بها 31 يوم وشهر 2 إذا كان فيه 28 يوم أو 29 يوم 2. انا: كود حساب الفرق بين تاريخين (موجود في الاكسس ، اذا ضغطت على F1 وانت في VBA) ، فهو يحسب المدة ، آخذ في الاعتبار السنوات الكبيسة والبسيطة 3. انت: ما زال يطلع عندي خطأ في التقرير ، أريد الاحتساب على طريقتنا بس كيف يمكن لي أن أظهر في النموذج آخر مدة من دون تفصيل في طريقة الاحتساب كما في النموذج المرفق 4. انا: عني انت ما تريد طريقة حسابي ، وانما تريد طريقة حسابك ، صح؟ لوسمحت تعبئي لي نموذج وترسله ، لاني مافهمت قصدك 5. انت: مرفق أمثلة 6. انا: ايش دخل المثال اللي ارسلته في رقم 5 ، بالطريقة اللي عرضتها في الرقم 3؟ الله يخليك: أ- هل تريد ان تستعمل الكود (وليس شكل النموذج) ، هل تريد استعمال الكود اللي انا اعطيتك او الكود اللي انت تستعمله؟ ب- رجاء عبئ لي مثال على نفس النموذج اللي تريدني اعمل لك الكود عليه (يعني اريد اعرف اخلي الارقام في اي حقول). جعفر

وعليكم السلام أخوي ابراهيم هالله هالله و شوي شوي علينا انت الله هداك مسمي الاستعلام نفس اسم التقرير ، والنموذج نفس اسم الجدول لازم تميزهم عن بعض ، علشان المسألة تصير سهلة عليك وعلينا ، وعلشان برمجتك تصير صحيحة البارحة ما انتبهت للمعلومات اعلاه ، فكنت اعتقد بان q_all هو اسم استعلام وما انتبهت للكود openReport ، فاعتقدت بانه OpenQuery ، وهذا كله بسبب التسميات واخي رمهان ماقصر ، واخبرني عن هذه الغلطة ، لكني شفت رسالته ورسائلك اليوم الصبح. تفضل ، التعديل والسموحة جعفر 31.Inpaco - Copy.accdb.zip

وعليكم السلام أخي ابراهيم 1. الكود صحيح اللي انت عملته: Private Sub Command57_LostFocus() Dim I As Byte Dim copyN As Integer copyN = Me.k_no For I = 1 To copyN DoCmd.OpenReport "q_all" Next I End Sub ولكن بدله ، علشان ما يكون على حدث اللي هو عليه الان ، وانما لازم يكون على حدث ضغط الزر ، هكذا: Private Sub Command57_Click() Dim I As Byte Dim copyN As Integer copyN = Me.k_no For I = 1 To copyN DoCmd.OpenReport "q_all" Next I End Sub 2. في البرنامج ، غير الاستعلام q_all من استعلام عادي ، الى استعلام الحاق ، بس لا تعمل الحاق للحقل Serial. جعفر

أخوي محسن ، اشوفك واجد مدلعني

تفضل أخي وأستاذنا الكريم عبدالعزيز تفضل هذا الرابط لمثل هذا السؤال: http://www.officena.net/ib/index.php?showtopic=58653 جعفر

هممم ، ياأخي انا عندي ذنوب مش ذنب واحد فقط يعني كم موضوع لازم اكتب علشان الله جل وعلا يغفر لي ذنوبي كلها حياك الله جعفر

شكرا جزيلا لك أخي أبوخليل بس هاي المواضيع المتميزة المثبتة وين رابطها؟ جعفر

أخي رمهان ترى المضمار لك ، واحنا راح نتفرج بس بس هالله هالله بصاحب الموضوع ، تراه ما بينتظر تجاربنا ، يريد الحل ، وان لها جعفر

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

السلام عليكم ورحمة الله وبركاته أخي اباعمرو ضع هذا الكود على زر استيراد جدول (بدل الكود القديم) Private Sub Command2_Click() Dim ImportFileName As String ImportFileName = CurrentProject.Path & "\MyBackup\سجل الكتب" & ".xls" 'DoCmd.TransferSpreadsheet acImport, 8, "جدول تسجيل الكتب", ImportFileName, True DoCmd.DeleteObject acTable, "Temp" DoCmd.TransferSpreadsheet acImport, 8, "Temp", ImportFileName, True Dim fld As Field Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Temp") mySQL = "INSERT INTO [جدول تسجيل الكتب] ( title, [اسم المؤلف], [مكان النشر], الناشر, ملاحظات ) Select" For Each fld In rst.Fields i = i + 1 If i <> 1 Then mySQL = mySQL & " [" & fld.Name & "]," End If Next mySQL = Mid(mySQL, 1, Len(mySQL) - 1) & " From Temp" 'Debug.Print mySQL CurrentDb.Execute (mySQL) End Sub جعفر

ان شاء الله باصداراتها التالية والمحسنة جعفر

يا أبوخليل ، كان زين انك من زمان تذكر الورد علشان تنشط ذاكرة أخينا ومهان فكر بشئ أخر كذلك محفز ومنشط جعفر

هلا والله بالمحسن

الله يطول في عمرك أخوي هاي نتيجة حسابكم وهاي نتيجة حسابي وانت قرر جعفر

وعليكم أخي وائل صحيح انا شايب ، بس مب من زمان الديناصورات وانزلت مرفق الكود ، ولم اجد به بصماتي (نعم ، استطيع ان ارى بصمتي في الكود ) والآن ، فلنبدأ بصفحة جديدة ما هو المطلوب (وبالتفصيل لوسمحت) ، ورجاء ارفاق ملفك جعفر

أخي محسن كل اللي كنت محتاج له هو رقم الملف الكود السابق كان للمجلد الذي تم اختياره فقط ، غير هذا الكود: Private Sub cmdfrom_Click() 'open the Open Folder dialog Me.DataBaseFromPath = BrowseFolder("which folder") 'if the user didn't select any folder, exit If Len(Me.DataBaseFromPath & "") = 0 Then Exit Sub 'list the .mdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.mdb", , Me.lst_Files) 'list the .accdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.accdb", , Me.lst_Files) End Sub والكود الحالي يشمل جميع المجلدات اللي داخل المجلد الذي تم اختياره ، فغير الكود اعلاه الى: Private Sub cmdfrom_Click() 'open the Open Folder dialog Me.DataBaseFromPath = BrowseFolder("which folder") 'if the user didn't select any folder, exit If Len(Me.DataBaseFromPath & "") = 0 Then Exit Sub 'list the .mdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.mdb", True, Me.lst_Files) 'list the .accdb files from the folder Call ListFiles(Me.DataBaseFromPath, "*.accdb", True, Me.lst_Files) End Sub جعفر

شكرا أخي رضون

أخي محسن الرابط التالي يعطيك طريقة اخرى لعمل اللي تريده: http://www.officena.net/ib/index.php?showtopic=59784&p=383494 جعفر

وعليكم السلام أخي رمهان جميل جدا ، فكرة رائعة وبسيطة في الواقع هناك سؤال ينطبق عليه مثالك ، وهو: http://www.officena.net/ib/index.php?showtopic=59803 وساذكر هناك رابط مثالك جميل

نعم يصير حتى بـ accde او mde ، ولكن بالطريقة التالية: 1. اعمل جدول ، واجعل فيه مجموعة حقول (تابع علشان تعرف كم حقل) ، 2. تستطيع ان تغير اي شئ في النموذج ، وذلك بأخذ القيمة من الجدول ، واعطائه للحقل في النموذج عند حدث "الحالي" ، 3. في حال اعطائك قيمة في الجدول ، فيمكنك قرأتها هكذا مثلا: a=dlookup(....,....,...) me.text1.BackColor = a 4. انظر الرابط التالي: http://www.officena.net/ib/index.php?showtopic=59818 انا وضعته خصيصا لك حتى تفهم قصدي بانك تستطيع ان تأخذ القيمة من الجدول وتعمل بها ما تشاء جعفر

السلام عليكم ورحمة الله وبركاته 🙂 في الواقع ، عرضت هذا الموضوع في منتدى الفريق العربي للبرمجة سابقا ، ولكني اعرضه هنا ، حتى تعم الفائدة ويستفيد منه الجميع. في بعض الاحيان نعمل برنامج بلغة معينة (العربية مثلاً) ، ثم لاحقا نريد هذا البرنامج لمستعملين بلغة اخرى (الانجليزية او الفرنسية مثلاً) ، مما يضطرنا ان نعمل نسخة اخرى من البرنامج 😞 اضع بين يديكم طريقة عمل برنامج بعدة لغات ، والطريقة هي الاحتفاظ بالمعلومات المطلوبة (ولا اقصد البيانات) في جدول. 1. هذه هي البيانات بلغات 3 ، العربية والانجليزية والفرنسية (والكلمات تم ترجمتها من الانجليزية الى الفرنسية عن طريق Google Translation): الخانات الموجودة بسيطة ومعرفة معناها لا يأخذ وقت ، اما تنسيق الحقل فهو:1. اسم الخط ، 2. حجم الخط ، 3. ثخانة الخط ، 4. منحني ، 5. تحته خط ، 6. لون الخط: 2. النموذج الرئيسي ، به واجهة البرنامج (والتي سنراها على الجهة اليمنى من الشرائح التالية) ، واول نموذج هو لعمل التغييرات على تنسيق الحقل ، وذلك بالنقر المزدوج في الحقل ، فتنفتح لنا نافذة اختيار الخط ، وعندما نطمئن لإختيارنا للخط ، يجب ان نحفظ هذا التنسيق ، وذللك للّغة التي نريدها: 3. اما النتائج المرجوة من البرنامج ، فتظهر لنا في هذا النموذج: باللغة العربية: باللغة الانجليزية: وباللغة الفرنسية: والكود الذي يقوم بجلب الكلمات والتنسيق هو التالي ، ولا يوجد حاجة الى تغيير الكود ، وانما العمل يكون بإضافة الخانات في الجدول: Private Sub Form_Load() On Error GoTo err_Form_Load mySQL = "Select * From tbl_Controls_Properties" mySQL = mySQL & " WHERE Form_Name='" & Me.Name & "'" mySQL = mySQL & " AND Language='" & Forms!frm_Main!Lang & "'" Dim rst As DAO.Recordset Dim x() As String Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst iTwips = 576 '576 twips/cm , 1440 twips/inch For i = 1 To rst.RecordCount Me(rst!ctl_Name).Caption = rst!ctl_Caption Me(rst!ctl_Name).Left = rst!ctl_Left * iTwips If Len(rst!ctl_Style & "") <> 0 Then x = Split(rst!ctl_Style, "|") With Me(rst!ctl_Name) .FontName = x(0) .FontSize = x(1) .FontWeight = x(2) .FontItalic = x(3) .FontUnderline = x(4) .ForeColor = x(5) If rst!Language = "A" Then '0=General '1=Left '2=Center '3=Right '4=Distribute .TextAlign = 3 Else .TextAlign = 1 End If End With End If rst.MoveNext Next i Exit Sub err_Form_Load: If Err.Number = 438 Or Err.Number = 13 Then 'ignor, Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub وهذا الكود الذي يفتح لنا msgbox : Public Function aRemark(N) 'call the Arabic Remarks in Table tbl_Controls_Properties aRemark = DLookup("[Remark]", "tbl_Controls_Properties", "[Form_Name]='" & Me.Name & _ "' And [Language]='" & Forms!frm_Main!Lang & _ "' And [Remark_ID] = " & N) End Function هذا البرنامج برنامج بدائي ، والذي يمكن تطويره 🙂 جعفر MultiLanguage2.zip

شكرا جزيلا أخي يوسف ولتأكيد كلامك ، انا ابدا ما استعملت لوحة البديل ، لهذا السبب ما اعرف الاجابة على هذا السؤال ، ورحم الله إمرأ عرف قدر نفسه جعفر

اكتب لي في صفحة اكسل ، عمود اسم الحرف ، وعمود اسم الحرف البديل