Jump to content
بحث مخصص من جوجل فى أوفيسنا
Custom Search

صالح حمادي

أوفيسنا
  • Content Count

    1,349
  • Joined

  • Last visited

  • Days Won

    27

صالح حمادي last won the day on February 24

صالح حمادي had the most liked content!

Community Reputation

1,203 Excellent

About صالح حمادي

  • Rank
    فريق الموقع
  • Birthday 02/25/1988

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    أستاذ
  • Location
    الجزائر
  • Interests
    البرمجة بالأكسس

Recent Profile Visitors

2,817 profile views
  1. التاريخ يجب أن يحدث كل مرة تدخل فيها إلى البرنامج أو عند إغلاق البرنامج حسب الصور التي أرسلتها لي يبدو أنك عدلت على الكود و نسيت إضافة الرمز # يجب وضعه قبل و بعد التاريخ DoCmd.RunSQL "update tbl_date set date_program=#" & Now & "#"
  2. السلام عليكم تفضل أدخل الاحداثيات التي تريد الصورة أن تنتقل إليها ثم أضغط على الصور move_img.rar
  3. السلام عليكم تفضل إليك هذا المثال به ما تريد إن شاء الله منع تعديل تاريخ الجهاز.rar
  4. أهلين بك أخي محمد السائل يريد إستبدال صندوق الرسائل الخاص بالأكسس برسائل يستطيع تصميمها هو كما يشاء لقد قمت بإضافة تصميم للرسالة الأولى في هذا التعديل DB.rar
  5. نعم تستطيع فعلها بنفس الطريقة و إذا لقيت الوقت راح أعطيك مثال في مرفقك
  6. السلام عليكم تستطيع إنجاز نموذج صغير به نص الرسالة و يظهر مكان صندوق الرسائل DB.rar
  7. الموضوع قديم جدا أنظر إلى التاريخ أخي طاهر يغلق
  8. السلام عليكم أضف مربع نص في تذييل الصفحة و أكتب فيه اسم مربع النص الموجود في تذييل التقرير. مثال: لديك مربع نص في تذييل التقرير اسمه txt1 و مكتوب فيه count(*) نضيف مربع نص آخر في تذييل الصفحة و نضع في مصدر عنصر التحكم : =txt1
  9. أهلين أخي أبا جودي المرفق إشتغل معي بشكل جيد لكن عندما نقلت الكود إلى ملف بصيغة 2003 آخر لم يشتغل معي غير صيغة الملف إلى 2007 اشتغل الكود أنا عملته على أكسس 2010 ما هو الخطأ الذي ظهر معك
  10. السلام عليكم تقبل الله منا و منكم الصلاة و الصيام و القيام إن شاء الله أقدم لكم اليوم كود لضغط و إصلاح قاعدة البيانات الحالية ضع هذا الكود في وحدة نمطية: 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
  11. السلام عليكم ضع هذا الكود في وحدة نمطية 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
  12. نعم أخي قم بفتح موضوع جديد بهذا الخصوص و سوف أجيبك عليه إن شاء الله
  13. مرحبا بك أخي العزيز لكل صيغة دورها في بعض الأحيان نضطر لإخراج التقرير على شكل صورة لغرض معين مثلا صادفت طلب من إحدى المؤسسات أن يتم إخراج التقارير على شكل صورة ليتم طباعتها من طابعة خاصة بطباعة بطاقات التعريف و لا تقبل إلا الصور.
  14. السلام عليكم . تقبل الله منا و منكم الصلاة و الصيام و القيام إن شاء الله لقد قمت بإضافة تحديث للبرنامج يمكن الزبون من تأجيل عملية إغلاق البرنامج لأجل حفظ العمل المتواجد بين يده. أضفت زر أمر في نموذج العد التنازلي عند الضغط عليه يغير العد من 60 و يغير حجم النموذج و ينقله للركن العلوي في الجهة اليسرى من الشاشة close pro.rar
×
×
  • Create New...