jjafferr

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

تفضل أخي وأستاذنا الكريم عبدالعزيز تفضل هذا الرابط لمثل هذا السؤال: 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

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

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

وعليكم السلام اخي شوف الرابط التالي ، يمكن يفيدك http://www.officena.net/ib/index.php?showtopic=59803 جعفر

تفضل نسختي ولكن يجب تغيير اسم ملف power point في الكود. وهذا الكود: لفتح العرض ، ايقافه ، واغلاقه Option Compare Database Dim opj As Object Private Sub cmd_run_Click() Dim strFilePath strFilePath = CurrentProject.Path & "\30.Office_Exercises.ppt" Set opj = CreateObject("Powerpoint.Application") opj.Visible = True opj.Presentations.Open (strFilePath) ': SendKeys "{F5}" opj.ActivePresentation.SlideShowSettings.Run 'Set opj = Nothing End Sub Private Sub cmd_stop_Click() opj.SlideShowWindows(1).View.Exit End Sub Private Sub cmd_exit_Click() opj.Quit Set opj = Nothing End Sub جعفر 30.Run_PowerPoint.mdb.zip

وهذا الكود لإيقاف العرض opj.SlideShowWindows(1).View.Exit جعفر

اعذروني يا شباب للمداخلة ولكني احب اتفادى Sendkeys فايش رايكم بهذا الكود: Dim opj As Object Dim strFilePath strFilePath = CurrentProject.Path & "\Ch1.ppt" Set opj = CreateObject("Powerpoint.Application") opj.Visible = True opj.Presentations.Open (strFilePath) ': SendKeys "{F5}" opj.ActivePresentation.SlideShowSettings.Run Set obj = Nothing جعفر

نفس الموضوع في هذا الرابط وهو يعمل ولكن هناك طلب كذلك: http://If Err.Number = 53 Then 'No file to delete, ignore Resume Next جعفر