محمد ايمن

يتضح من الصورة ان نوع ملفات القرص NTFS وانك قد قمت بتفعيل تشفير الملفات لهذا القرص او ارشفة الملفات او ضغطها ( لم اعد اذكر اسم الخاصية ) المهم جرب ان تضع قاعدة البيانات على فلاشة مثلا و ان تشغلها واذا علمت معك بشكل سليم عليك ان تعدل الخاصية المذكورة اعلاه

السلام عليكم ورحمة الله و بركاته اصدقائي هذا التطبيق هو تطوير لهذا الموضوع في الموضوع السابق كان يجب علينا كتابة اسم السيرفر و اسم قاعدة البيانات ضمن الكود للارتباط بالجداول في هذا التطبيق نستطيع عرض سيرفرات SQL الموجود على الجهاز و اختيار السيرفر و اختيار قاعدة البيانات واختيار نوع الاتصال للارتباط بالجداول طبعا يجب اضافة المرجع SQLDMO.DLL الى البرنامج وهنا يتم اضافة المرجع برمجيا دون اي تدخل من المستخدم الملف SQLDMO.DLL يجب ان يكون في نفس مسار قاعدة البيانات Dim DB As Database Dim RS As Recordset2 Dim TblName As String Dim Td As TableDef ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub chk1_AfterUpdate() If Me.chk1 = True Then Me.TUserName.Enabled = False Me.TPassWord.Enabled = False Else Me.TUserName.Enabled = True Me.TPassWord.Enabled = True End If End Sub ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub Cm1_Click() On Error GoTo ErrSub If IsNull(Me.Comp1) Then MsgBox "يرجى اختيار السيرفر", vbCritical Exit Sub End If If IsNull(Me.Comp2) Then MsgBox "يرجى اختيار اسم قاعدة البيانات", vbCritical Exit Sub End If If Me.chk1 <> 1 And (IsNull(Me.TUserName) Or IsNull(Me.TPassWord)) Then MsgBox "يرجى ادخال اسم المستخدم و كلمة المرور", vbCritical Exit Sub End If For Each Td In CurrentDb.TableDefs If Len(Td.Connect) <> 0 Then CurrentDb.TableDefs.Delete Td.Name End If Next DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";Trusted_Connection=Yes", acTable, "INFORMATION_SCHEMA.TABLES", "INFORMATION_SCHEMA_TABLES" Set DB = CurrentDb Set RS = DB.OpenRecordset("INFORMATION_SCHEMA_TABLES", dbOpenTable) RS.MoveFirst Do While RS.EOF = False TblName = RS.Fields(2) If Me.chk1 = 1 Then DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";Trusted_Connection=Yes", acTable, TblName, TblName Else DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1 & ";Database=" & Me.Comp2 & ";UID=" & Me.TUserName & ";PWD=" & Me.TPassWord, acTable, TblName, TblName End If RS.MoveNext Loop RS.Close Me.Comp2.RowSource = "" DoCmd.Close acTable, "sysdatabases" DoCmd.DeleteObject acTable, "INFORMATION_SCHEMA_TABLES" DoCmd.DeleteObject acTable, "sysdatabases" MsgBox "تم الارتباط بكافة الجداول بنجاح", vbInformation ErrSub: If Err.Number <> 0 Then MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight End If End Sub ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub Cm2_Click() Dim i As Integer Dim oNames As SQLDMO.NameList Dim oSQLApp As SQLDMO.Application Dim SysServerCount As Integer Set oSQLApp = New SQLDMO.Application Set oNames = oSQLApp.ListAvailableSQLServers() SysServerCount = oNames.Count Me.Comp1.AllowValueListEdits = True Me.Comp1.RowSourceType = "Value List" If SysServerCount = 0 Then Me.Comp1.RowSource = "local" Else For i = 1 To SysServerCount Me.Comp1.AddItem oNames.Item(i) Next i Me.Comp1.AllowValueListEdits = False End If Me.Comp1.SetFocus Me.Comp1.Dropdown End Sub ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub Comp1_AfterUpdate() On Error GoTo ErrSub DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=" & Me.Comp1.Value & ";Database=master;Trusted_Connection=Yes", acTable, "sys.databases", "sysdatabases" Me.Comp2.RowSource = "SELECT sysdatabases.name, sysdatabases.is_auto_close_on FROM sysdatabases WHERE (((sysdatabases.is_auto_close_on)=-1))" Me.Comp2.SetFocus Me.Comp2.Dropdown ErrSub: If Err.Number <> 0 Then End If If Err.Number = 3059 Then MsgBox "تاكد من تشغيل السيرفر", vbCritical + vbMsgBoxRight End If End Sub ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub Form_Close() On Error Resume Next DoCmd.DeleteObject acTable, "sysdatabases" End Sub ------------------------------------------------------------------------------------------------------------------------------------------- Private Sub Form_Load() On Error Resume Next With Access.References .AddFromFile CurrentProject.Path & "\SQLDMO.DLL" End With End Sub Link All Table.rar

تفضل اخي الكريم TAGREBA1.rar

وعليكم السلام اخي الكريم اسم الجدول مكرر الجدول : TBL Traige Roon ماهي وظيفته؟ ايضا الجدول tbl_Vital_Sign غير موجود في المرفق !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ايضا الجدول tbl_Patient_Info اسمه مكرر في الشرح !!!!!!!!!!!!!!!!!!!!!!!!!!!! اقترح عليك اخي الكريم ان تهدا اعصابك وتكتب على مهلك تفاديا للاخطاء المرفق الذي ارسلته لي يحتوي على الجداول التالية TBLAppointment ماهو ؟؟؟؟ TBLDrugs جدول الادوية TBLLab جدول المختبر TBLMedicalReport جدول التقارير الطبية TBLPatientInfo جدول بيانات المريض TBLPrescription اسم الجدول مكرر في الشرح !!! TBLReferral تخزين حالات المرضى ( سنتكلم عن هذا الجدول لاحقا ) TBLTraigeRoon ماهو ؟؟؟؟؟ TBLUserSecurity جدول المستخدمين TBLXray جدول صور الاشعة ملاحظة : قمت بالغاء (_) من اسماء الجداول حاول قدر الامكان ان تبتعد عن المسافة و ال (_) في تسمية الحقول و الجداول

السلام استاذي الكريم ابو خليل انا اويد كلامك وكلام اخينا محمد النجار وارى ان جدول المرضى وتحديدا رقم المريض هو المحور الاساسي عن طريق هذا الرقم نستطيع عرض كل شيئ اخي الكريم ارجو منك شرح اسماء الجداول لكي استطيع وضع فكرة لعمل البرنامج

اخي الكريم تحية طيبة مازلنا نتكلم عن المرحلة الاولى وهي تصميم الجداول ومن المبكر التتحدث عن النقاط التي ذكرتها 1- قمت بتعريف رقم المريض ( نص ) ويجب ان يكون رقما 2- لايوجد علاقات بين الجداول 3- بعض الجداول لايوجد فيها سوى حقل Auto_ID وهو ترقيم تلقائي ( مثلا جدول tbl_xray) ارجو منك ان تشرح اسماء الجداول وللحديث بقية

تحية طيبة اخي السيد جمال

الاصدقاء الاكارم تحية طيبة هذا الموضوع هو تطوير للمشاركة التالية وقبل ان ابدا اريد التوجه بالشكر لاخينا السيد جمال السيد فهو من دفعني الى البحث لتطوير هذا الكود وانا هنا لا اقصد التقليل من اهمية الكود الذي طرحه اخينا جمال بالعكس هذا الموضوع هو تطوير للفكرة طرح اخينا جمال وحدتين نمطيتين للاتصال بقاعدة بيانات SQL ولكن كلا الوحديتن فيهما نقاط ضعف الوحدة النمطية الاولى '//Name : AttachDSNLessTable '//Purpose : Create a linked table to SQL Server without using a DSN '//Parameters '// stLocalTableName: Name of the table that you are creating in the current database '// stRemoteTableName: Name of the table that you are linking to on the SQL Server database '// stServer: Name of the SQL Server that you are linking to '// stDatabase: Name of the SQL Server database that you are linking to '// stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection '// stPassword: SQL Server user password Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String) On Error GoTo AttachDSNLessTable_Err Dim td As TableDef Dim stConnect As String For Each td In CurrentDb.TableDefs If td.Name = stLocalTableName Then CurrentDb.TableDefs.Delete stLocalTableName End If Next If Len(stUsername) = 0 Then '//Use trusted authentication if stUsername is not supplied. stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes" Else '//WARNING: This will save the username and the password with the linked table information. stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword End If Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect) CurrentDb.TableDefs.Append td AttachDSNLessTable = True Exit Function AttachDSNLessTable_Err: AttachDSNLessTable = False MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Description End Function وفى حدث عند فتح النموذج ستضيف الكود التالى Private Sub Form_Open(Cancel As Integer) If CreateDSNConnection("(اسم السرفر )", "اسم قاعدة البيانات ", "اسم المستخدم ", "كلمة السر ") Then '// All is okay. Else '// Not okay. End If End Sub نقطة الضعف هنا انه يجب عليك تكرار الكود لكل جدول و بالتالي كل جدول = سطر برمجي ماذا لو نسي المستخدم جدولا ما !!!!!! الوحدة النمطية الثانية '//Name : CreateDSNConnection '//Purpose : Create a DSN to link tables to SQL Server '//Parameters '// stServer: Name of SQL Server that you are linking to '// stDatabase: Name of the SQL Server database that you are linking to '// stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection '// stPassword: SQL Server user password Function CreateDSNConnection(stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String) As Boolean On Error GoTo CreateDSNConnection_Err Dim stConnect As String If Len(stUsername) = 0 Then '//Use trusted authentication if stUsername is not supplied. stConnect = "Description=myDSN" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr & "Trusted_Connection=Yes" Else stConnect = "Description=myDSN" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr End If DBEngine.RegisterDatabase "myDSN", "SQL Server", True, stConnect '// Add error checking. CreateDSNConnection = True Exit Function CreateDSNConnection_Err: CreateDSNConnection = False MsgBox "CreateDSNConnection encountered an unexpected error: " & Err.Description End Function هذه الوحدة النمطية تقوم بانشاء اتصال DSN وتسجيله في الويندوز لكننا ما زلنا بحاجة الى اضافة الجداول يدويا نعود الى الوحدة النمطية الاولى لانها افضل و اسهل في التعامل توفر قاعدة بيانات SQL جدولا اسمه INFORMATION_SCHEMA.TABLES ( في الاصدار 2005 وما فوق اما في اصدار 2000 لا اعلم اذا كان موجودا ) هذا الجدول يحتوي على اسماء الجداول الموجودة في قاعدة بيانات SQL الفكرة الآن نقوم باستيراد هذا الجدول و نستخرج اسماء الجداول منه و ننفذ حلقة دورانية للارتباط بكافة الجداول On Error GoTo ErrSub Dim DB As Database Dim Rs As Recordset2 Dim TblName As String 'استيراد الجدول الذي يحتوي اسماء الجداول في قاعدة بيانات SQL المحددة '//DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=اسم السيرفر;Database=اسم قاعدة البيانات;Trusted_Connection=Yes", acTable, "INFORMATION_SCHEMA.TABLES", "INFORMATION_SCHEMA_TABLES" ' استيراد الجدول الى قاعدة البيانات DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;Driver={SQL Server};Server=HP-PC\SQLEXPRESS;Database=data1;Trusted_Connection=Yes", acTable, "INFORMATION_SCHEMA.TABLES", "INFORMATION_SCHEMA_TABLES" Set DB = CurrentDb ' فتح الجدول Set Rs = DB.OpenRecordset("INFORMATION_SCHEMA_TABLES", dbOpenTable) ' فتح الجدول ' الذهاب الى السجل الاول Rs.MoveFirst ' حلقة دورانية تتوقف عند الوصول الى السجل الاخير في الجدول السابق Do While Rs.EOF = False ' استخراج اسماء الجداول من الحقل الثاني في الجدول و تخزينها في المتغير TblName = Rs.Fields(2) ' استدعاء الوحدة النمطية للارتباط بالجدول '//Call AttachDSNLessTable(TblName, TblName, "اسم قاعدة البيانات", "اسم السيرفر", "", "") Call AttachDSNLessTable(TblName, TblName, "HP-PC\SQLEXPRESS", "data1", "", "") ' الذهاب الى السجل التالي Rs.MoveNext Loop ' اغلاق الجدول Rs.Close ' حذف الجدول بعد الانتهاء من الارتباط DoCmd.DeleteObject acTable, "INFORMATION_SCHEMA_TABLES" MsgBox "تم استيراد كافة الجداول بنجاح", vbInformation ErrSub: If Err.Number <> 0 Then MsgBox Err.Number & vbCrLf & Err.Description End If Import All Table From Sql DataBase.rar

تفضل اخي الكريم pass-unprotected.rar

انشء نموذج وضع فيه زر امر و ضع هذا الكود فيه بعد تنفيذ الكود اغلق النموذج و سيظهر الجدول

لن تستطيع فتح الجدول وستظهر رسالة خطا تعذر العثور على الكائن لان الخاصية له هي الرقم (1) ( لا اعلم ماذا يعني هذا الرقم) استخدم هذا الكود لتعديل خاصية الجدول الى الرقم (0) ثم سيظهر الجدول وتستطيع فتحه و تعديل تصميمه كما ترغب Dim aa As TableDef Dim dd As dao.Database Set dd = CurrentDb For Each aa In dd.TableDefs If aa.Name = "tab1" Then aa.Attributes = 1 End If Next

تحية طيبة اخي الكريم انت عدلت خاصية الجدول الى الرقم 1 وبذلك لم يظهر عند عرض الجدول المخفية و جداول النظام

استخدمت جميع البرامج لاظهار باسوورد قاعدة البيانات لكنها لم تظهر !!!!!!!!!!!!!!!!!!!!!! يعني لازلت في الشوط الاول

تحية طيبة اخي الكريم المرفق الذي ارسلته يفي بالغرض ولكن كانت الفكرة من الوحدة النمطية هي في حال رغبة المستخدم في استخدام القيم اكثر من مرة او لاكثر من نموذج

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

تفضل اخي الكريم DB1.rar

تفضل اخي الكريم db11.rar

تفضل اخي الكريم rate update1.rar

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

اقتراحي لك هو ان تبدا بتنفيذ برنامج جديد تضع فيه كافة الافكار التي تود تنفيذها عوضا عن التعديلات على البرنامج القديم لان هذا البرنامج يحتوي تعديلات بالجملة و كثرة التعديلات في النهاية ستقودك الى اخطاء برمجية لها بداية و ليس لها نهاية وان احببت ان تبدا من جديد انا معك

والله يا اخي سعيد انا متلك افضل جمل SQL اشعر انها اسهل و اسرع

بشكل مبدئي لديك خطا في النموذج Table1 Requête وهو ان الحقل A1 غير موجود في مصدر البيانات ( الاستعلام ) كما ان الكود الموجود في زر تاريخ اليوم يشير الى اسم نموذج غير موجود اذا كنت تريد التاريخ من الجدول عليك استخدام الدالة Dlookup اما اذا كنت تريد اظهار التاريخ الحالي عند الضغط على الزر عليك كتابة هذا الكود عوضا عن الكود السابق Me.De_A1 = Date اما اذا كنت تريد تحديث التاريخ الموجود في الجدول عليك استخدام جملة SQL للتحديث

تفضل اخي الكريم انشئ مجلد في جهاز السيرفر باسم img في القرص D ولا تنسى مشاركته كما ذكرت لك سابقا جرب ووافينا بالنتيجة program.rar

تفضل اخي الكريم tesetprint.rar

بسم الله ما شاء الله زادك الله علما و نفعا فكرة رائعة بكل معنى الكلمة