صالح حمادي

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

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

السلام عليكم حياك الله أخي عبد الله أظن أن كثرة ضغط و إصلاح قاعدة البيانات قد يضر بالقاعدة و ربما تفقد جميع بياناتك لذلك أرى أن هذا الحل ليس مناسبا هل تستخدم الكود لتحديث حالة المستخدم أو عن طريق تشغيل استعلام مخزن في ملف الواجهة؟ هل تقوم بتشغيل الإستعلام عند خروج أحد المستخدمين؟ و هل تظهر الرسالة عند خروج أحد المستخدمين قبل أن يعاود الدخول؟

السلام عليكم أخي الكريم @لاتبخل يا ريت تضع لك اسم معبر نستطيع مناداتك به تقبل فائق احتراماتي لشخصك الكريم

التاريخ يجب أن يحدث كل مرة تدخل فيها إلى البرنامج أو عند إغلاق البرنامج حسب الصور التي أرسلتها لي يبدو أنك عدلت على الكود و نسيت إضافة الرمز # يجب وضعه قبل و بعد التاريخ DoCmd.RunSQL "update tbl_date set date_program=#" & Now & "#"

السلام عليكم تفضل أدخل الاحداثيات التي تريد الصورة أن تنتقل إليها ثم أضغط على الصور move_img.rar

السلام عليكم تفضل إليك هذا المثال به ما تريد إن شاء الله منع تعديل تاريخ الجهاز.rar

أهلين بك أخي محمد السائل يريد إستبدال صندوق الرسائل الخاص بالأكسس برسائل يستطيع تصميمها هو كما يشاء لقد قمت بإضافة تصميم للرسالة الأولى في هذا التعديل DB.rar

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

السلام عليكم تستطيع إنجاز نموذج صغير به نص الرسالة و يظهر مكان صندوق الرسائل DB.rar

الموضوع قديم جدا أنظر إلى التاريخ أخي طاهر يغلق

السلام عليكم أضف مربع نص في تذييل الصفحة و أكتب فيه اسم مربع النص الموجود في تذييل التقرير. مثال: لديك مربع نص في تذييل التقرير اسمه txt1 و مكتوب فيه count(*) نضيف مربع نص آخر في تذييل الصفحة و نضع في مصدر عنصر التحكم : =txt1

أهلين أخي أبا جودي المرفق إشتغل معي بشكل جيد لكن عندما نقلت الكود إلى ملف بصيغة 2003 آخر لم يشتغل معي غير صيغة الملف إلى 2007 اشتغل الكود أنا عملته على أكسس 2010 ما هو الخطأ الذي ظهر معك

السلام عليكم تقبل الله منا و منكم الصلاة و الصيام و القيام إن شاء الله أقدم لكم اليوم كود لضغط و إصلاح قاعدة البيانات الحالية ضع هذا الكود في وحدة نمطية: Function Allenda_Compact() 'On Error Resume Next Dim mdb_Path_Name As String Dim wrkAcc As Object Dim dbsNew As Object Dim file_data As String Dim app As Access.Application Dim frm As Form Dim crt As Control Dim old_name_frm As String Dim new_name_frm As String Dim str_code As String Dim name_new_db As String Dim name_old_db As String name_new_db = Application.CurrentProject.Path & "\prog-comp.accdb" name_old_db = Application.CurrentDb.Name '----------------------------------------------------------إنشاء ملف أكسس جديد mdb_Path_Name = Environ("Temp") & "\compact-repair.accdb" Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet) If Dir(mdb_Path_Name) <> "" Then Kill mdb_Path_Name Set dbsNew = wrkAcc.CreateDatabase(mdb_Path_Name, dbLangGeneral) dbsNew.Close wrkAcc.Close '---------------------------------------------------------------------------إنشاء نموذج Set app = CreateObject("Access.Application") app.OpenCurrentDatabase (mdb_Path_Name) app.Visible = False 'True Set frm = app.CreateForm old_name_frm = frm.Name new_name_frm = "form01" app.DoCmd.Save acForm, old_name_frm app.DoCmd.Close acForm, old_name_frm app.DoCmd.Rename new_name_frm, acForm, old_name_frm '--------------------------------------------------------------------------- اضافة الكود للنموذج المنجز app.DoCmd.OpenForm new_name_frm, acDesign 'Set crt = app.CreateControl(new_name_frm, acCommandButton, acDetail, , , L, t, "3000", "1000") 'crt.Caption = "compact and repair" str_code = "Dim x As Integer" & vbCrLf & _ "Private Sub Form_Timer()" & vbCrLf & _ "FileCopy " & Chr(34) & name_old_db & Chr(34) & " , " & Chr(34) & name_new_db & Chr(34) & vbCrLf & _ "Kill " & Chr(34) & name_old_db & Chr(34) & vbCrLf & _ "Set acc2007 = CreateObject(" & Chr(34) & "DAO.DBEngine.36" & Chr(34) & ")" & vbCrLf & _ "acc2007.CompactDatabase " & Chr(34) & name_new_db & Chr(34) & ", " & Chr(34) & name_old_db & Chr(34) & ", Nothing, Nothing" & vbCrLf & _ "Set acc2007 = Nothing" & vbCrLf & _ "Kill " & Chr(34) & name_new_db & Chr(34) & vbCrLf & _ "Application.FollowHyperlink " & Chr(34) & name_old_db & Chr(34) & vbCrLf & _ "Quit" & vbCrLf & _ "End Sub" & vbCrLf & _ "Private Sub Form_Load()" & vbCrLf & _ "Dim db As Object" & vbCrLf & _ "Set db = GetObject(" & Chr(34) & name_old_db & Chr(34) & ")" & vbCrLf & _ "db.Quit" & vbCrLf & _ "Set db = Nothing" & vbCrLf & _ "Me.TimerInterval = 500" & vbCrLf & _ "End Sub" app.Forms(new_name_frm).Module.AddFromString str_code app.DoCmd.Close acForm, new_name_frm, acSaveYes app.Quit acQuitSaveAll Set app = Nothing DoCmd.TransferDatabase acExport, "Microsoft Access", mdb_Path_Name, acMacro, "Autoexec1", "Autoexec", False Application.FollowHyperlink mdb_Path_Name End Function و نقوم بإستدعائها من خلال هذا الكود خلف زر أمر Allenda_Compact يوجد ماكرو في المرفقات اسمه Autoexec1 نقوم بنقله للقاعدة التي نريد ضغطها و إصلاحها. أرجوا تجربة المرفق و إعلامنا بالنتائج ضغط و إصلاح قاعدة البيانات الحالية.rar

السلام عليكم ضع هذا الكود في وحدة نمطية Public Function CreateTableLink(strBEPath, strSourceTableName, strPassword) As Boolean Dim db As DAO.Database Dim tdf As DAO.TableDef Dim strConnect As String Dim strLinkName As String strLinkName = strSourceTableName strConnect = "MS Access;PWD=" & strPassword & _ ";DATABASE=" & strBEPath Debug.Print strConnect Set db = CurrentDb Set tdf = db.CreateTableDef tdf.Connect = strConnect tdf.SourceTableName = strSourceTableName tdf.Name = strLinkName db.TableDefs.Append tdf Set tdf = Nothing Set db = Nothing End Function و ضع هذا الكود خلف زر أمر الإرتباط Dim BackFile As String Dim table_name As String Dim Password As String ' حذف الجداول المرتبطة الموجودة بقاعدة البيانات (الامامية Dim FrontObj As AccessObject, FrontDB As Object Set FrontDB = Application.CurrentData For Each FrontObj In FrontDB.AllTables If Left(FrontObj.Name, 4) <> "MSys" Then DoCmd.DeleteObject acTable, FrontObj.Name End If Next FrontObj Set FrontDB = Nothing 'إعادة الإرتباط Password = "1988" ' كلمة سر قاعدة البيانات BackFile = CurrentProject.Path & "\DB.accdb" 'مسار القاعدة المراد الإرتباط بها Dim BackObj As TableDef Dim BackDB As Object Set BackDB = DBEngine.Workspaces(0).OpenDatabase(BackFile, True, False, "MS Access;PWD=" & Password & ";DATABASE=" & CurrentProject.Path & "\DB.accdb") For Each BackObj In BackDB.TableDefs If Left(BackObj.Name, 4) <> "MSys" Then table_name = BackObj.Name Call CreateTableLink(CurrentProject.Path & "\DB.accdb", table_name, Password) End If Next BackObj Set BackDB = Nothing و هذا مثال على ذلك الارتباط بقاعدة بيانات محمية.rar

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

ممتاز جدا أخي تصميم رائع شكرا جزيلا

مرحبا بك أخي العزيز لكل صيغة دورها في بعض الأحيان نضطر لإخراج التقرير على شكل صورة لغرض معين مثلا صادفت طلب من إحدى المؤسسات أن يتم إخراج التقارير على شكل صورة ليتم طباعتها من طابعة خاصة بطباعة بطاقات التعريف و لا تقبل إلا الصور.

السلام عليكم . تقبل الله منا و منكم الصلاة و الصيام و القيام إن شاء الله لقد قمت بإضافة تحديث للبرنامج يمكن الزبون من تأجيل عملية إغلاق البرنامج لأجل حفظ العمل المتواجد بين يده. أضفت زر أمر في نموذج العد التنازلي عند الضغط عليه يغير العد من 60 و يغير حجم النموذج و ينقله للركن العلوي في الجهة اليسرى من الشاشة close pro.rar

السلام عليكم معذرة أخي محمد و كأنني لم أرى السؤال إلا الآن عندما كنت أتصفح الأرشيف تفضل إجابتك في هذا الكود و قد وضعت معه الشرح: Dim prt As Printer Dim prtOriginal As Printer Set prt = Application.Printers("اسم الطابعة التي نريد طباعة التقرير بها") Set prtOriginal = Application.Printer ' استخراج اسم الطابعة الإفتراضية في الجهاز Set Application.Printer = prt ' وضع الطابعة التي نريد الطباعة بها كطابعة إفتراضية DoCmd.OpenReport "اسم التقرير المراد طباعته", acViewNormal ' كود طباعة التقرير Set Application.Printer = prtOriginal ' إرجاع الطابعة الأصلية كطابعة إفتراضية Set prtOriginal = Nothing Set prt = Nothing Set Application.Printer = Nothing

هذا المنتدى للتعلم و ليس لطلب البرامج الجاهزة. يغلق

نعم هذا هو المطلوب و قد حصلت الفائدة و الحمد لله و لكن ما العيب في إستثارتكم بالنقاش البناء و الإستفادة منكم أنت و الأستاذ @ابوخليل أنا لم أدرس قواعد البيانات لكن طريقة تعيين المفتاح الأساسي في الأكسس تأكد هذه المعلومة لأنه لا يسمح لك بإضافة المفتاح الأساسي إلا بالضغط مرة واحدة و إذا قمت بتحديد حقلين أو ثلاثة سوف تجد علامة المفتاح قد وزعت على هذه الحقول المحددة. شكرا لكم جميعا و جزاكم الله خير الجزاء.

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

السلام عليكم ضع هذا الكود مكان الكود السابق خلف زر الأمر Dim curPath As String Dim i As Integer curPath = CurrentProject.Path & "\REPORT_SALES.xlsx" Do Until Dir(curPath) = "" i = i + 1 curPath = CurrentProject.Path & "\REPORT_SALES" & i & ".xlsx" Loop DoCmd.OutputTo acOutputTable, "REPORT_SALES", acFormatXLSX, curPath, 0

شكرا جزيلا أخي مثال رائع