ابو ياسين المشولي

العفو اخي jjafferr جعر نحن تلميذكم

بالتوفيق اخي

اتفضل اخي عدلت لك ظهور الاسم 958.سند قبض.accdb

انا اعتذر كان قصدي الرد بهذا الموضع ولا اعرف كيف تلخبطت

[جرب DoCmd.OpenForm "frm2 ", acNormal Me.tr.SetFocus

اتفضل طريقه الاستاذ جعفر.mdb

من خصائص النموذج انظر الصورة

لم تجبني على سوالي الاخير في هذة المشاركة

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

نعم اخي جعفر انا كان ودي استخدم الكود تبعك لانه بدون ان احدد القاعده لكن للاسف تجي رساله تم الحذف ولكن لم يتم شي وانا استعملت and ولكنه ما اشتغل معي ما اعرف السبب

شكرا اخي جعفر استخدمت الكود حقي وكانت النتيجه المطلوبه If Not (left(tdf.NAME, 4)) = "MSys" And tdf.NAME <> "User" Then للاسف اخي جعفر لم يتم حذف اي جدول

للاسف لم يضبط معي للمعلوميه انا قاعدتي منقسمه واريد احذف كل الجداول بستثناء جدول usre عندي كود يحذف كل الجداول هذا الكود كيف اضيف له شرط يسثني جدول Dim strSQL As String Dim tdf As TableDef Dim BackDB As DAO.Database Dim strPath As String strPath = CurrentProject.Path & "\data\tailor" Set BackDB = OpenDatabase(strPath) For Each tdf In BackDB.TableDefs If Not (left(tdf.NAME, 4)) = "MSys" And tdf.NAME <> "User" Then BackDB.Execute ("delete * from " & tdf.NAME) strSQL = "INSERT INTO " & tdf.NAME & " SELECT " & tdf.NAME & ".* FROM " & tdf.NAME & " IN '" & myfile & "';" BackDB.Execute (strSQL) End If Next DoCmd.Requery BackDB.Close Me.Refresh End If

للاسف اخي جعفر لم يتم حذف اي جدول

استاذ جعفر jjafferr اذا كانت القاعدة منقسمه واريد ان يستثني جدول ما كيف الطريقة

تسلم اخي جعفر بارك الله فيك طيب ممكن نتشرح لي هذا الكود وهو من مشاركتك في هذا الموضوع Dim WshShell, strCurDir Set WshShell = CreateObject("WScript.Shell") strCurDir = WshShell.CurrentDirectory WshShell.Run strCurDir & "\Nasystry.mdb", 2 Set WshShell = Nothing

الاخ jjafferr اذا فهمت قصدي ممكن تشاركني اريد تصغير 2 نموذج مع بعض وعند التكبير يرجعو مع بعض اكون شاكر لك هو الان انا اضفضت هذا ولكنه يعطيني رمزين عند المهام startForm MinimizeToTry Me.hwnd MinimizeToTry Forms!login.hwnd SetFormState 0

كم باسورد vb

اكتبه في حدث بعد التحديث او ارفع ملف مصغر يجرب عليه مع شرح المطلوب

جرب forms![سمي النموذج الفرعي].Refresh

كلامك صحيح اخي جعفر انا عندما انسخ كود من المنتدى يطلع لي هذة العبارة وانا استخدم في برنامجي ربط تلقائي هذة الداله Public Function Authorization1() ' DoCmd.RunCommand acCmdAppMinimize 'لاخفاء شاشة الاكسس ' DoCmd.ShowToolbar "ribbon", acToolbarNo 'لاخفاء ادوات الاكسس DoCmd.OpenForm "login2" End If ' On Error GoTo MyErr 'Beep 'MyErr: 'MsgBox " عفوا مجلد البيانات تم نقلة أو أعادة تسميتة " & Chr(13) & " لذا سوف يتم اغلاق البرنامج " & Chr(13) & " رجاء أذهب الى مصدر البرنامج وتأكد من وجود مجلد بأسم " & Chr(13) & " بجوار مجلد بـرنـامـج الـخـيـاط DATA ", vbYes, " بـرنـامـج الـخـيـاط : خطــــــأ " ' DoCmd.Quit End Function Public Function Authorization2() Dim obj_FSO As Object, obj_Drive As Object Set obj_FSO = CreateObject("Scripting.FileSystemObject") Set obj_Drive = obj_FSO.GetDrive("C:\") MsgBox "رقم التسجيل الخاص بنسختك هو " & obj_Drive.SerialNumber & " ", vbInformation, " بـرنـامـج الـخـيـاط : ترخيـــــــص " End Function Public Function acbRelink(strPath As String, Optional blnSilent As Boolean) As Boolean On Error GoTo alalal Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...") Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = _ dbAttachedTable Then tdf.Connect = "D:\بـرنـامـج الـخـيـاط\data\tailor" tdf.RefreshLink End If Next Call SysCmd(acSysCmdClearStatus) If blnSilent Then MsgBox " تم العوده الى النسخه الأصليه مره أخرى ", vbInformation, " بـرنـامـج الـخـيـاط : النسخه الأصليه " End If alalal: If err.Number = 3024 Then Beep MsgBox " عفوا مجلد البيانات تم نقلة أو أعادة تسميتة " & Chr(13) & " لذا سوف يتم اغلاق البرنامج " & Chr(13) & " رجاء أذهب الى مصدر البرنامج وتأكد من وجود مجلد بأسم " & Chr(13) & " بجوار داخـل بـرنـامـج الـخـيـاط DATA ", vbYes, " بـرنـامـج الـخـيـاط : خطــــــأ " DoCmd.Quit End If End Function Public Function DataReceived() DoCmd.Beep If MsgBox(" !!! تـحـذيـر هل أنت متأكد " & Chr(13) & " من رغبتك في العودة للنسخة الاصلية ؟؟؟ ", vbYesNo, " بـرنـامـج الـخـيـاط : النسخه الأصليه ") = vbYes Then Call acbRelink(Trim(Replace(Application.CurrentProject.Path & "\" & "D:\بـرنـامـج الـخـيـاط\data\tailor", Chr$(0), " ")), True) End If End Function Public Function acbRelink2(strPath As String, Optional blnSilent As Boolean) As Boolean On Error GoTo alalal Call SysCmd(acSysCmdSetStatus, "Re-linking the data tables...") Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = _ dbAttachedTable Then tdf.Connect = ";DATABASE=" & "D:\بـرنـامـج الـخـيـاط\data\tailor" tdf.RefreshLink End If Next Call SysCmd(acSysCmdClearStatus) alalal: If err.Number = 3024 Or err.Number = 2001 Then DoCmd.Beep MsgBox " عفوا مجلد البيانات تم نقلة أو أعادة تسميتة " & Chr(13) & " لذا سوف يتم اغلاق البرنامج " & Chr(13) & " رجاء أذهب الى مصدر البرنامج وتأكد من وجود مجلد بأسم " & Chr(13) & " بجوار مجلد بـرنـامـج الـخـيـاط DATA داخل مجلد tailor وملف بأسم DATA ", vbYes, " بـرنـامـج الـخـيـاط : خطــــــأ " DoCmd.Quit End If End Function Public Function DataReceived2() ' HideAccess 'لاخفاء شاشة الاكسس Call acbRelink2(Trim(Replace(Application.CurrentProject.Path & "\" & "D:\بـرنـامـج الـخـيـاط\data\tailor", Chr$(0), " ")), True) End Function

بارك الله فيك

الوزير دائما هو السباق انا كنت عدلتها الى هذا =DSum("[Alkmiah]";"Hrakatsanf";"[ID_Sanf]='" & [ID_Sanf] & "'" & "and [Atarih] >=#" & [t] & "#")

بارك الله في الجميع

اتفضل اخفار واظهار.accdb

في اي امر تختارة في النموذج