صالح حمادي

نعم يمكنك ذلك بهذا الشكل: DoCmd.RunSQL "CREATE TABLE " & me.name_table & _ "([FriendID] integer," & _ "[LastName] text," & _ "[FirstName] text," & _ "[Birthdate] date," & _ "[Phone] text," & _ "[Notes] memo," & _ "CONSTRAINT [Index1] PRIMARY KEY ([FriendID]));" بحيث name_table هو اسم مربع النص في النموذج

رحمه الله برحمته الواسعة إن شاء الله

السلام عليكم هذه طريقة أخرى ربما تفي بالغرض سوف يكون شكل التقرير في وضع التصميم هكذا: و شكل التقرير في وضع المعاينة هكذا: - و قد استعملت هذا الكود لتحديد إرتفاع و مكان ظهور التقارير الفرعية في التقرير الرئيسي. Dim RC2 As Integer, RC3 As Integer, RC4 As Integer Dim i As Double Dim heig_r2 As Double, heig_r3 As Double, heig_r4 As Double i = 566.9291338583 RC2 = [rpt_2].Report![nrow2] heig_r2 = (1.085 + (0.503 * (RC2 + 2) / 2) + 0.45) * i Me.rpt_2.Height = heig_r2 '----------------------- Me.rpt_3.Top = heig_r2 + 5.5 * i RC3 = [rpt_3].Report![nrow3] heig_r3 = (1.085 + (0.503 * (RC3 + 1) / 2) + 0.45) * i Me.rpt_3.Height = heig_r3 '----------------------- Me.rpt_4.Top = Me.rpt_3.Top + heig_r3 + 0.5 * i RC4 = [rpt_4].Report![nrow4] heig_r4 = (1.085 + (0.503 * (RC4 + 1) / 2) + 0.45) * i Me.rpt_4.Height = heig_r4 '----------------------- Me.Label119.Top = Me.rpt_4.Top + heig_r4 + 0.5 * i Me.Sum_raseedafter.Top = Me.rpt_4.Top + heig_r4 + 0.5 * i و غيرت خصائص التقارير الفرعية على النحو التالي: أضفت حقل Expr1 فارغ لمصدر السجلات (الإستعلامات) من أجل إضافة تجميع لتقرير الفرعي 1- و غيرت خاصية تكرار المقطع إلى نعم للعنصر رأس_expr1 كما في الصورة: 2- تغيير خاصية التقرير "اتجاه" إلى من اليمين إلى اليسار و هذا هو المرفق: 680.3.الاجازات - Copy.rar

السلام عليكم هذه ليست مشكلة بل هو أمر طبيعي لأن جهاز الباركود مبرمج على أن يطبع الشيفرة + الضغط على زر Entrée لذلك يقوم المؤشر بالنزول للسطر التالي

السلام عليكم. يمكنك ذلك بـإتباع الخطوات التالية: 1- الصفحة الرئيسية 2- الجزء "فقرة" 3- تباعد الأسطر

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

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

السلام عليكم استعمل هذا الكود: Dim NameTblimport As String Dim txtpathfile As String txtpathfile = "e:\database1.mdb" ' مسار قاعدة البيانات التي بها الجدول NameTblimport = "tbl1" ' اسم الجدول المراد استيراده DoCmd.TransferDatabase acImport, "Microsoft Access", txtpathfile, acTable, NameTblimport,NameTblimport , False

تفضل هذا التعديل: حساب الوقت.rar

السلام عليكم استعمل هذا الكود في حدث بعد التحديث لمربع نص البدء و مربع نص القفال: If DateDiff("n", Me.بدء_البلاغ, Me.اغلاق_البلاغ) < 30 Then Me.type_sortie = "خروج عادي" Else Me.type_sortie = "متأخر" End If و هذا هو المرفق حساب الوقت.rar

السلام عليكم مشاركة مع اخي ابوخليل ضع هذا الكود في حدث عند الضغط المزدوج على مربع القائمة DoCmd.SearchForRecord acDataForm, "Tahwela", acFirst, "[id] =" & Me.SearchList ‏‏دليل ارقام التحويلات.rar

أستاذ جعفر هذا الكود سوف يقوم بتغيير القيمة في الجدول كاملا و ليس النموذج الفرعي فقط لذلك اسمح لي بهذا التعديل الطفيف في السطر الأول من الكود الذي وضعته mySQL = "UPDATE Q1 SET [ÇáÍÇáÉ] = [Forms]![test1]![Change_to_this] where id=Forms![test1]![id1] " DoCmd.SetWarnings False DoCmd.RunSQL mySQL DoCmd.SetWarnings True Me.SUB.Form.Requery

السلام عليكم Me.SUB.SetFocus DoCmd.GoToRecord , , acFirst For i = 1 To [SUB].Form![nombre] Me.SUB.SetFocus [SUB].Form![work] = Me.نص36 DoCmd.GoToRecord , , acNext Next i Me.نص36.SetFocus جرب هذا المثال البسيط فهو يفي بالغرض test120.rar

1- إعمل ضغط و اصلاح لقاعدة البيانات سوف ينقص من حجمها 2- اعمل لها ضغط بإستعمال برنامج winrar بهذا الشكل يصبح حجمها قابل للإرفاق ههههه آسف لم أرى ردك على الموضوع أستاذ جعفر

العفو أخي الكريم

السلام عليكم نعم أخي كان هناك خطأ بسيط يمنع المرفق من العمل مع كل الملفات و لكنني أصلحته الآن تفضل: Dim strTargetDB As String Dim tbl As TableDef Dim app As Access.Application strTargetDB = Me.txtPath1 Set app = CreateObject("Access.Application") app.OpenCurrentDatabase (Me.txtPath) app.Visible = False For Each tbl In app.CurrentDb.TableDefs If Left(tbl.Name, 4) <> "MSys" Then app.DoCmd.TransferDatabase acExport, "Microsoft Access", strTargetDB, acTable, tbl.Name, tbl.Name, False End If Next MsgBox "لقد تم تصدير جميع الجداول بنجاح" و هذا هو المرفق: 1‏‏kanory.rar

البرنامج يعمل معي 100% جرب إنشاء قاعدة فارغة (mdb) و قم بتصدير الجداول لها من خلال قاعدة أخرى

السلام عليكم تفضل هذا التعديل على الكود الذي تستعمله: Dim strTargetDB As String Dim tbl As TableDef Dim app As Access.Application strTargetDB = Me.txtPath1 Set app = CreateObject("Access.Application") app.OpenCurrentDatabase (Me.txtPath) app.Visible = False For Each tbl In CurrentDb.TableDefs If Left(tbl.Name, 4) <> "MSys" Then app.DoCmd.TransferDatabase acExport, "Microsoft Access", strTargetDB, acTable, tbl.Name, tbl.Name, False End If Next و هذا ملفك بعد التعديل عليه موفق إن شاء الله 1‏‏kanory.rar

الحمد لله الذي تتم بنعمته الصالحات و فيك بارك الله أخي عادل موفق إن شاء الله

جرب هذا المرفق فهو متوافق مع 2003 فما فوق

متى تظهر هذه الرسالة عند فتح البرنامج أو عند التفعيل

يا أخي هذا ليس إشكال بل هو أبسط مما هو موجود غير الكود الموجود في الوحدة النمطية بهذا الكود: Function salah(frm1 As String, frm2 As String, frm3 As String) 'On Error Resume Next Dim firstdate As Date Dim lastdate As Date Dim lasttime As Date Dim expdate As Date Dim nameschool As String Dim numschool As Double Dim khawarezmia As String Dim nember_days As Integer '-------------------------------------------------------------------- firstdate = GetSetting("aa", "bb", "firstdate", Nz(firstdate)) If firstdate = Empty Then SaveSetting "aa", "bb", "firstdate", Date End If firstdate = GetSetting("aa", "bb", "firstdate", Nz(firstdate)) '--------------------------------------------------------------------- lastdate = GetSetting("ss", "tt", "lastdate", Nz(lastdate)) If lastdate = Empty Then SaveSetting "cc", "dd", "lastdate", Date End If lastdate = GetSetting("ss", "tt", "lastdate", Nz(lastdate)) '--------------------------------------------------------------------- lasttime = GetSetting("zz", "hh", "lasttime", Nz(lasttime)) If lasttime = Empty Then SaveSetting "ee", "ff", "lasttime", Now End If lasttime = GetSetting("zz", "hh", "lasttime", Nz(lasttime)) '--------------------------------------------------------------------- nember_days = GetSetting("mm", "nn", "nember_days", Nz(nember_days)) If nember_days = Empty Then nember_days = 1 End If expdate = DateAdd("d", nember_days, firstdate) '--------------------------------------------------------------------- khawarezmia = GetSetting("gg", "pp", "khawarezmia", Nz(khawarezmia)) If khawarezmia = Empty Then numschool = DLookup("numscho", "tbl") SaveSetting "ii", "jj", "numschool", numschool khawarezmia = DLookup("khawr", "tbl") khawarezmia = Replace(khawarezmia, "numschool", numschool) SaveSetting "gg", "pp", "khawarezmia", khawarezmia nameschool = DLookup("namescho", "tbl") SaveSetting "kk", "ll", "nameschool", nameschool nember_days = DLookup("nemberday", "tbl") SaveSetting "mm", "nn", "nember_days", nember_days End If For Each ttable In CurrentData.AllTables If ttable.Name = "tbl" Then DoCmd.DeleteObject acTable, ttable.Name End If Next If nember_days=140 Then DoCmd.OpenForm frm2 DoCmd.Close acForm, frm1 Else DoCmd.OpenForm frm3 DoCmd.Close acForm, frm1 End If End Function

السلام عليكم يوجد هناك برنامج جاهز يعطيك جميع هذه الخصائص و أكثر اسمه aSc TimeTables https://asc-timetables.ar.uptodown.com/windows

ما هي نسخة الأوفيس التي تستعملها هل استعملت المرفق الأخير أم المرفق الأول

في هذا السطر من كود التفعيل غير العدد 140 إلى أي عدد تريده