د.كاف يار

تفضل هذا التعديل اخي الكريم On Error Resume Next Set conn = CreateObject("ADODB.Connection") conn.Provider = "Microsoft.ACE.OLEDB.12.0" conn.Open "Data Source = C:\Users\H\Desktop\FRm_Refresh.accdb" Set rs = CreateObject("ADODB.recordset") Dim MyData As String MyData = "tblchfit" rs.Open "Select * from " & MyData, conn If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) Me!ImagesNewTb![Image Path] = rs.Fields("Edate") DoCmd.GoToRecord , , acNext rs.MoveNext Wend End If rs.Close Set rs = Nothing

بسيطه اخي الكريم استخدم الكود التالي set conn=Server.CreateObject("ADODB.Connection") conn.Provider="Microsoft.Jet.OLEDB.4.0" ' اصدار قاعدة البيانات conn.Open "مسار قاعدة البيانات" set rs=Server.CreateObject("ADODB.recordset") Dim MyData as string MyData=" اسم جدول مصدر البيانات" rs.Open "Select * from " & MyData , conn for each x in rs.fields MsgBox rs.Fields("FieldsName") next

تفضل هذا التعديل اخي الكريم تم اضافة عمود جديد بإسم تاريخ الالحاق update_farez (1).rar

تفضل هذا المثال اخي الكريم MyImage.accdb

اخي الكريم ماهو المقصود بتقسيم الملفات الى مجلدات ؟؟ في حال تريد انشاء ملف بإسم محدد استخدم الكود التالي Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim fldNewName As String fldNewName ="اسم المجلد" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & fldNewName If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If و لحفظ نسخة من ملف مجدد في مجلد محدد استخدم الكود التالي فقط انسخ و الصق الكود بالكامل واضعه في حدث ازرار مع مراعاة تعديل ما يلزم ================== انشاء مجلد =========================== Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim fldNewName As String fldNewName ="اسم المجلد" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & fldNewName ' هنا شرط في حال لم يجد المجلد في المسار اعلاه سيتم انشاء مجلد جديد If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If ================== تصفح الملفات لاختيار الصورة =========================== Dim Addfile As Object Dim xFile As String Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "All Files", "*.*" If .Show = True Then xFile = Trim(.SelectedItems(1)) Else Exit Sub End If End With ================== حفظ الصورة المختارة =========================== Dim MyFile, DstFile As String Dim Syso As Object Dim IDStudint As String IDStudint =[هنا حقل رقم هوية الطالب في النموذج] MyFile = xFile ' مسار الصورة المختارة من متصفح الملفات اعلاه DstFile = CurrentProject.Path & "\" & fldNewName & "\" & IDStudint & ".jpg" ' هنا مسار الصورة الجديد في المجلد الجديد DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing

لعرض القيم بدون تكرار استخدم DISTINCT كما هو موضح في المثال ادناه SELECT DISTINCT Company FROM Orders تفضل مثالك بعد التعديل المحل نسخة تجريبية.accdb

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

اخي الكريم تفضل هذا المثال اخي الكريم لقد شرحت فيه جميع الاجراءات في داخل الكود المثال سهل للغاية MyImage.zip

تفضل هذه المشاركة من قبلي اخي الكريم Database1.accdb

اخي الكريم من الأفضل ان تفصل قاعدة البيانات عن باقي البرنامج و تضع رقم سري كما تريد لقاعدة البيانات

اها اعتذر عن سوء الفهم تفضل طلبك ترقيم حسب الشهر.mdb

تفضل التعديل اخي الكريم في شهر سيتم اضافة رقم جديد ترقيم حسب الشهر.mdb

اخي الكريم تفضل هذه المحاولة db1.mdb

تفضل اخي الكريم سيتم اعادة الترقيم لكل شهر ترقيم حسب الشهر.mdb

تفضل المثال MyData.accdb

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

اخي الكريم من وجهة نظري اختيارك لقاعدة بيانات SQL Server فهي افضل اختيار لأمن و حماية البيانت اما التقارير فأنصحك بتقارير الكرستال او تقارير الفيجوال اما الواجهات في بأي لغة دائما افضل بأن تكون باللغة التي تتقنها لكي تسهل التعامل بها من قبلك كمبرمج فالأقرب الى الاكسس هي VB و C#

اخي الكريم لإنشاء مجلد بالرقم الوظيفي استخدم الكود التالي Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim strSQL As String Dim MyFields As String Dim rs As DAO.Recordset MyFields = "اسم عمود الرقم الوظيفي في الجدول" Set rs = CurrentDb.OpenRecordset("اسم الجدول") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & rs.Fields(MyFields) If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) Me.FolderPath = CurrentProject.Path & "\" & rs.Fields(MyFields) End If rs.MoveNext Wend End If rs.Close Set rs = Nothing و لنسخ ملف استخدم الكود التالي Dim MyFields As String Dim rs As DAO.Recordset MyFields = "الرقم الوظيفي" Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "All Files", "*.*" If .Show = True Then Dim MyFile, DstFile, MyFileTayb As String Dim Syso As Object MyFile = Trim(.SelectedItems(1)) DstFile = CurrentProject.Path & "\" & MyFields & Right(MyFile, 4) DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Else Exit Sub End If End With

تفضل التعديل اخي الكريم test (2).accdb

xlast = DMax("fatoraid", "tblfatora", "left(fatoraid, 2) = myfatoratype()") انت بتستدعي اكبر رقم في قاعدة البيانات و ثم تقوم بإضافة رقم +1 الى المجموع بعد تقسيم الرقم xnext = Val(Mid(xlast, 3, 5)) + 1 و في الأخير بتضبط تنسيق الأرقام Me.FatoraId = prtyr & Format(xnext, "00000") لكن يبقى موضوعك مبهم لم تذكر ما ذا تريد

مرفق التطبيق MyData.accdb

تفضل هذا التعديل بناء على تعديل اخي ازهر test (1).accdb

تفضل هذا العديل Dim strDbFile, strConnect As String strDbFile = "مسار قاعدة البيانات" strConnect = "MS Access;DATABASE=" & strDbFile Dim tdf As DAO.TableDef Dim db As DAO.Database Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then tdf.Connect = strConnect tdf.RefreshLink End If Next

مبروك لنا و لكم و للجميع هذا الانسان الراقي أبو آمنة أخوك / د.كاف يار ( حسين كمال )

تفضل اخي الكريم Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim MyFolderName As String MyFolderName= "عنصر التحكم او اسم المجلد" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & MyFolderName If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If