نجوم المشاركات

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

الظاهر في حد جاب طاريي 😁 بخبرك بالطريقة الاسهل (الطريقة الاصعب يحتاج لها بخور ، فنخليها لوقت الحاجة 🙂 ) اعمل تقرير جديد بنفس الاسم TMPCLP284581ّ~ ، وبعد ان تحفظه ، ينحذف تلقائيا ، بس قبل شهر رمضان المبارك 🙂 جعفر

السلام عليكم 🙂 حل مثل هذه الامور : 1. ضغط واصلاح لقاعدة البيانات (مثل ما اشار اخوي ابوعبدالله) ، 2. انشىء قاعدة بيانات جديدة ثم استورد اليها جميع الكائنات (مثل ما اشار اخوي ابوعبدالله) ، 3. اعمل تقرير جديد بنفس الاسم TMPCLP284581ّ~ (واذا كانت المشكلة في نموذج ، فاعمل نموذج بنفس الاسم) ، وبعد ان تحفظه ، ينحذف تلقائيا ، 4. استعمل هذا الكود لحذف جميع انواع هذه الكائنات : وهناك موضوع كامل عن كائنات اخرى كذلك قد تكون عالقة في البرنامج : How to remove 'deleted database objects' from the MSysObjects table | Access World Forums (access-programmers.co.uk) Function Delete_TMPCLP_Objects() 'Delete the ~TMPCLP objects Dim rst As DAO.Recordset Dim mySQL As String mySQL = "SELECT Name, Type FROM MSysObjects " mySQL = mySQL & " WHERE Name Like '~TMPCLP*'" Set rst = CurrentDb.OpenRecordset(mySQL) Do Until rst.EOF Select Case rst("Type") Case 1, 4, 6 'Tables DoCmd.DeleteObject acTable, rst("Name") Case 5 'Queries DoCmd.DeleteObject acQuery, rst("Name") Case -32768 'Forms DoCmd.DeleteObject acForm, rst("Name") Case -32764 'Reports DoCmd.DeleteObject acReport, rst("Name") Case -32766 'Macros DoCmd.DeleteObject acMacro, rst("Name") Case -32761 'Modules DoCmd.DeleteObject acModule, rst("Name") Case Else Debug.Print rst("Type"), rst("Name") End Select rst.MoveNext Loop rst.Close: Set rst = Nothing End Function . جعفر

اعتذر منك اخوي حسام ، لم انتبه انك عملت فرز تنازلي ، فعليه ، كلامي اعلاه في غير محله 🙂 جعفر

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

السلام عليكم 🙂 انا متأكد بأن الاستاذ احمد لم يلاحظ هذه العلاقة 🙂 لهذا السبب ، طريقته سوف تخل بطريقة عمل البرنامج ، يعني اذا كانت قيمة iPage_ID (في الجدول tbl_Pages) = iPage (في الجدول tbl_Items) = 3 فقمت بتغيير الرقم 3 الى الرقم 5 في iPage (في الجدول tbl_Items) ، فتظل قيمة iPage_ID (في الجدول tbl_Pages) 3 ، كما كانت ، وهذا يجعل القيمة 5 يتيمة في الجدول tbl_Items ، وبدون ربط مع الجدول tbl_Pages !! كلامك صحيح ، ولكن يحتاج الى تعديل بسيط ، . اذا بدأت الـ Loop من 1 الى آخر قيمة (من الاصغر الى الاكبر) : - فلما تغير الرقم 1 فيصبح 1+1 = 2 ، فمعناه ان جميع قيم الجدول tbl_Items بدلا عن 1 اصبحت 2 ، فهنا يتم خلط القيم هناك ، قيم 1 و 2 تصبح 2 ، - ولما تغير الرقم 2 فيصبح 2+1 = 3 ، فمعناه ان جميع قيم الجدول tbl_Items بدلا عن 2 اصبحت 3 ، فهنا يتم خلط القيم هناك ، قيم 1 و 2 و 3 تصبح 3 ، يعني في نهاية الـ Loop ، جميع القيم هناك ستكون بالرقم الاخير 😁 ولكن ، iPage_ID (في الجدول tbl_Pages) لا يقبل التكرار 😁 لذا ولحل الموضوع بالطريقة الصحيحة ، يجب ان تبدأ الـ Loop من آخر قيمة الى 1 (من الاكبر الى الاصغر). جعفر

مشاركة مع استاذي العزيز احمد حسب فهمي لطلبك هو انك تريد ان تضيف حساب بين حسابين في جدول tbl_Pages وان كان هذا الفهم صحيح فالطريقة التي اتبعها الاستاذ احمد وان كانت تعطي نتائج صحيحية ولكنها غير منطقية فنيا اذ التتعديل يجب ان يجري في الجدول اعلاه وتلقائيا سيتم التعديل في جدول tbl_Items لان العلاقة بينهما علاقة راس باطراف مع فرض التكامل المرجعي وهذا التعديل فيه طلبك الاخير وموضحا الفكرة وكذلك استاذن الاستاذ احمد باستخدام النموذج وعذرا للاطالة DATA1000.rar

اهلا ومرحبا بك اخى واستاذى العزيز @husamwahab تسعدنى مشاركتك جزاك الله خيرا نعم فطريقتك منطقيه واصح لوجود العلاقه وبدون استئذان اخى حسام وان وجب الاستئذان فعلينا بالاستئذان من اخى ومعلمى العزيز جعفر فهو من قام بتصميم هذا البرنامج حسب متطلبات اخى الفاضل ابوالحسن جزاك الله خيرا اخى نعم اخى واستاذى العزيز @jjafferr لم انتبه لوجود العلاقه الا بعد طلب الاضافه من خلال الاكسس من اخى الفاضل @abouelhassan ولكن كنت استعد للنوم للسفر باكر ولسه راجع من السفر والحمد لله اخى حسام جزاه الله خيرا قدم المساعده تمنياتى لكم بالتوفيق وكل عام وانتم بخير

وعليكم السلام-تفضل اف الشرطية1.xlsx

شكرا شكرا لك استاذ سليم على هذا السعى الدائم لمساعدتى ربنا يبارك فيكم وفى زريتكم ويجعلها زريه صالحة ويرزقكم الفردوس الاعلى

تم التعديل Private Sub btnSubmit_Click() If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Then Exit Sub Dim S_rg As Range, Col%, i% Dim Sw As Worksheet Dim BoL As Boolean Dim last% Set Sw = Sheets("Sheet1") last = Sw.Cells(Rows.Count, 1).End(3).Row Set S_rg = Sw.Range("C2:L2") _ .Find(Me.ComboBox1.Text, lookat:=1) If S_rg Is Nothing Then Exit Sub Col = S_rg.Column For i = 3 To last If Sw.Cells(i, Col) = "" Then BoL = True Exit For End If Next If BoL Then Sw.Cells(i, Col) = _ Me.ComboBox2.Text End Sub Fauzi_User_vertical.xlsm

بنفس الطريقة اضافة شرط كود الالية اذا كان الكود من نوع رقم DSum("[total]", "tbl_name", "[bil_number]=" & bil_number) اذا كان من نوع نص DSum("[total]", "tbl_name", "[bil_number]='" & [bil_number] & "'") قد نحتاج الى اضافة في الكود اذا كان رقم الالية غير موجود في النموذج لاستخراجة من مربع القائمة ليعمل الشرط بشكل صحيح المشكلة انك اخي لم تضع مرفق ليسهل عليك وعلى كل من يرغب مساعدتك بدلا من التخمين

وعليكم السلام-انتبه من فضلك فطلبك طبعاً مستحيل عمله وتنفيذه بالمعادلات ... لا يمكن عمله الا بالأكواد ... بارك الله فيك بالتأكيد أعلم هذا يقيناً ولكن ليس هناك حيلة لطلبك الا بالأكواد لأنك تقوم بالإدخال فى صف واحد وعند مسحه وعمل ادخال جديد سيتم بناءاً عليه بالتبعية حذف كل البيانات القديمة المرحلة سابقاً ... أظن كده الموضوع أصبح واضح ومكتمل الأركان بالنسبة لك !

هل يمكنك رفع قاعدة البيانات للنجربة وحل المشكلة باذن الله تحياتي

العلاقات تتم داخل الاستعلام اذا في الاكسس او في الداتا سيت اذا في لغة اخرى

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

وعليكم السلام-تفضل بالتنسيقات الشرطية مهم1 .xls

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير اللهم آمين وجميع المسلمين والمسلمات والمؤمنين والمؤمنات ان شاء الله نعم اضف ما تريد ثم حدثهم بالترتيب من الاصغر الى الاكبر يعنى 2 ثم 3 وهكذا وده تعديل بسيط باضافه كمبو تختار منه Private Sub btnRun_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb strSql = "SELECT tbl_Items.iPage " & _ "FROM tbl_Items " & _ "WHERE tbl_Items.iPage >= " & Me!cmbIPageID.Column(0) If IsNull(cmbIPageID) Then MsgBox "من فضلك اختر القيمه التى تريد تحديثها" Me.cmbIPageID.SetFocus Me.cmbIPageID.Dropdown Exit Sub End If Set rs = db.OpenRecordset(strSql) rs.MoveLast: rs.MoveFirst For i = 0 To rs.RecordCount - 1 rs.Edit rs.Fields(0) = rs.Fields(0).Value + 1 rs.Update rs.MoveNext Next Me!cmbIPageID = "" rs.Close db.Close Set rs = Nothing Set db = Nothing End Sub بالتوفيق DATA14_2.mdb

طبعاً وبالتأكيد لا يمكن عمل هذه المعادلة فى الإصدار القديم فهى غير متوفرة الا بالإصدارات الحديثة بداية من 2016 وشكراً جزيلاً على الرغم انك لم تقم برفع الملف تجنباص لإهدار الوقت وحيث انه لا يمكن العمل على التخمين فحاول استخدام المعادلة هكذا =IFERROR(VLOOKUP($A1040;القسم!$A$4:$N$1200;6;0);VLOOKUP($C1040;بيانات!$A$2:$I$990;7;0))

تفضل كان عليك استخدام خاصية البحث بالمنتدى تجنباً لإهدار الوقت خصوصاً ان طلبك تكرر كثير جداً بالمنتدى أو بكل بساطة يمكنك استخدام هذه المعادلة لتلبية طلبك وحله =DATE(IF(LEFT(A3,1)*1=3,20,19)&MID(A3,2,2),MID(A3,4,2),MID(A3,6,2)) (مميز ) دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي Text1.xlsm

السلام عليكم ربما تم التقسيم حسب الجدول Sub test() Dim m As Object, a, i, ii a = Range("a2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1) ReDim b(1 To UBound(a), 1 To 5) With CreateObject("VBScript.RegExp") .Global = True .Pattern = "(\d+){1,2}|(\W+)" For i = 1 To UBound(a) Set m = .Execute(a(i, 1)) For ii = 1 To 3 b(i, ii) = m(ii - 1) Next b(i, 4) = Split(Trim(m(ii - 1)))(0) b(i, 5) = Mid(Trim(m(ii - 1)), Len(b(i, 4)) + 1) Next End With c = 0: cc = 1 For x = 1 To UBound(b) Step 22 [b2].Offset(, cc + c - 1).Resize(22, 5) = Application.IfError _ (Application.Index(b, Evaluate("row(" & x & ":" & x + 22 & ")") _ , Array(1, 2, 3, 4, 5)), "") c = c + 1: cc = cc + 4 Next End Sub

جرب هذا الملف Option Explicit Sub Show_hide() Dim S As Worksheet Dim i%, Ro% Set S = Sheets("Salim") With S Ro = .Cells(Rows.Count, 1).End(3).Row .Range("B1").Resize(, 17) _ .EntireColumn.Hidden = False For i = 2 To 16 Step 2 If .Cells(3, i) = vbNullString Then .Cells(3, i).Resize(, 2) _ .EntireColumn.Hidden = True End If Next .PageSetup.PrintArea = _ .Range("A2").Resize(Ro-1, 17).Address .PrintPreview End With End Sub '+++++++++++++++++++++++++++++++++++++++++++++ Sub show_Al_Col() Sheets("Salim").Range("B:Q").EntireColumn.Hidden = False End Sub الملف مرفق Fathi.xlsm

الاصدقاء الاكارم تحية طيبة هذا الموضوع هو تطوير للمشاركة التالية وقبل ان ابدا اريد التوجه بالشكر لاخينا السيد جمال السيد فهو من دفعني الى البحث لتطوير هذا الكود وانا هنا لا اقصد التقليل من اهمية الكود الذي طرحه اخينا جمال بالعكس هذا الموضوع هو تطوير للفكرة طرح اخينا جمال وحدتين نمطيتين للاتصال بقاعدة بيانات 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