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

كود لاخفاء الجداول والاستعلامات كلمة السر 123 Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllTables Set tdf = db.TableDefs(obj.NAME) If left(tdf.NAME, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If Next For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.NAME, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 Set tdf = Nothing db.Close Set db = Nothing وهذا اظهار الاستعلامات Retry: TimerId = SetTimer(0, 0, 1, AddressOf TimerProc) Dim MyPassword As String str_Title = "كلمة السر مطلوبه" str_Prompt = "أدخـل كـلـمـة الـسـر لاظهار الجداول والاستعلامات" MyPassword = InputBox(str_Prompt, str_Title) Select Case MyPassword Case "123" Beep MsgBox "الأن... يـمكـنـك اظهار الجدالول", vbOKOnly + vbInformation Case Else Beep If MsgBox(" عــفــوا .. كــلــمــة الــســر خــاطــئــة " & vbCrLf & " مــن حــســن إســـلام الـمــرء تــركــه مــا لا يــعــنــيــه ", vbInformation + vbRetryCancel) = vbRetry Then GoTo Retry Exit Sub MsgBox "تم الرجوع", vbInformation, "إلغاء العملية" End Select Dim db As Database Dim obj As AccessObject, dbs As Object Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.NAME, False Next obj Set dbs = CurrentDb For Each tdf In dbs.TableDefs If left(tdf.NAME, 4) <> "msys" And tdf.Attributes <> 1073741824 _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If Next tdf Set dbs = Nothing db.Close Set db = Nothing

بعد اذن اخي الوزير تصحيح فقط لانه عمله على كود vb ويفرق بينهم , وهذة ; =Nz(DSum("[Price]";"[selling]";"[selling Case]<>'deleted '");0)

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

العفو اخي ابو زاهر بالتوفيق

اعمل استعلام عند حذف الماده او ارفق مثال

جرب الان فاتورة احترافية.accdb

ارفق مثال يطبق عليه

كيف اغير الشريط

للرفع

انفضل اخي هذا كود يحذف كل الجداول الموجوده بالقاعده ماعليلك سوى تغير مسار القاعده وصيغتها مثلا انا عمامل mdb Dim x Beep x = MsgBox(" سـوف يـتـم حـذف كـل الـبـيـانـات الـمـسـجـلـة سـتـفـقـد كـل شـي هـل تـريـد الاسـتـمرار " & vbCrLf & "", vbYesNo, " بـرنـامـج الـخـيـاط ") Dim strSQL As String Dim tdf As TableDef Dim BackDB As DAO.Database Dim strPath As String strPath = CurrentProject.Path & "\data\tailor.mdb" Set BackDB = OpenDatabase(strPath) For Each tdf In BackDB.TableDefs If Not (Left(tdf.NAME, 4)) = "MSys" 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 MsgBox " تـم حـذف كـل الـبـيـانـات الـمـسـجـلـة بـنـجـاح", vbInformation, " بـرنـامـج الـخـيـاط " BackDB.Close

نعم ولكن لم يجد لها اجابه

شكرا اخي ولكن ليس هو المطلوب هذا الكود هو يحرك النموذج انا اريد كود يتحكم بخط تسميه توضيحيه بالنموذج

شكرا لك اخي سوف اشوفه واعطيك خبر

بالتوفيق

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

اتفضل

لم اعدل غير الكود اخي محمد

مازال الامل يرودني اني بجد له حل

وهذا بالكود بعد اذن اخي Shivan Rekany زياده خير الحاق سجل1.mdb

اتفضل اتمنى يكون هو طلبك لم انتبه بان الاخ Shivan Rekany قد اجاب على السوال وزياده الخير خيرن 1 (4).accdb

للرفع

اتفضل اخي محمد قاسم 12 اتمنى يكون هو الصح Dim i, x As Long i = Nz(Me.Qtyout) x = Nz(Me.rsd) If i > x Or x = 0 Then MsgBox "الرصيد لا يغطي" DoCmd.CancelEvent Undo Qtyout = "" Exit Sub Else Total = Nz(Qtyout) * Nz(PRICESALE) End If

مرورك اخي Khalf لكي تتضح لكم الصورة اريد اتحكم بحجم خط النموذج التسميه التوضيحيه انا عامل في النموذج عند حدث التحميل هذا ولكن يطلع الخط صغير وما عرفت كيف اجعله كبير Me.Form.Caption = DLookup(" [اسم المحل] ", "الجدول") & Space(100)

شكرا لمرورك اخي ابو زاهر ماقصرت