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

وهي الطريقة التي استخدمها في اعمالي وحدة نمطية وكود للربط داخل النموذج انسخ الكود التالي والصقه في وحدة نمطية عامة Public Function CheckLinks(ByVal strDBPassword As String) As Boolean On Error GoTo CheckLinksErr Dim tdf As TableDef Dim strNewMDB As String Dim fd As FileDialog For Each tdf In CurrentDb.TableDefs If UCase(Left(tdf.Name, 6)) <> "COMPAS" Then If Len(tdf.Connect) > 0 And tdf.Fields.Count = 0 Then If Len(strNewMDB) = 0 Then Call MsgBox("مطلوب قم بتحديده واختياره (اسم قاعدة الجداول لديك) ملف البيانات", vbCritical) Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .InitialFileName = CurrentDBFolder() .Filters.ADD "Access Database File (*.mdb)", "*.mdb", 1 .TITLE = "Select Back-End Data File" .ButtonName = "Link Tables" If .Show = False Then Exit Function Else strNewMDB = .SelectedItems(1) End If End With End If If (IsNull(strDBPassword) = True) Or (strDBPassword = "") Then tdf.Connect = ";DATABASE=" & strNewMDB Else tdf.Connect = ";DATABASE=" & strNewMDB & ";PWD=" & strDBPassword End If tdf.RefreshLink End If End If Next tdf CheckLinks = True CheckLinksDone: Exit Function CheckLinksErr: MsgBox "Error #" & err.Number & ": " & err.Description, vbCritical Resume CheckLinksDone End Function Public Function CurrentDBFolder() As String Dim strPath As String strPath = CurrentDb.Name Do While Right$(strPath, 1) <> "\" strPath = Left$(strPath, Len(strPath) - 1) Loop CurrentDBFolder = strPath End Function ثم الصق الكود التالي في حدث التحميل لنموذج البداية On Error Resume Next If CheckLinks("") = False Then Call Quit End If Dim tdfs As DAO.TableDefs Dim tdf As TableDef Dim sSourceDB As String Dim sBackupDB As String Dim backDBName As String Set tdfs = CurrentDb.TableDefs Set tdf = tdfs(tdfs.Count - 1) sSourceDB = Right(tdf.Connect, Len(tdf.Connect) - 10) backDBName = Dir(Mid(tdf.Connect, 11)) sBackupDB = Mid(tdf.Connect, 11, Len(tdf.Connect) - (Len(backDBName) + 10)) ' وفي المثال تطبيق للمقال ملحوظة : اذا لم يعمل المثال على الوجه الأكمل انظر في المكتبات link_be.rar

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

و عليكم السلام و رحمة الله وبركاته جزاك الله خيرا عبى مرورك الكريم 1- تم الإغلاق عند 50 عميل لأنها نسخة تجريبية وهي يجب ان يكون حجمها صغير جدا - يمكنك تعديل النطاق للبيانات كما تريد و تكبر القائمة 2- من تحقق من صحة يمكنك تفعيلها او تغييرها الى بيانات اخرى 3- هي نسخة تجريبية لعمل الأفكار واخذ الخبرة منها مع التحية

يشهد الله اكثر من سنتين و انا افكر في هذا الكود لكن دون اي فائدة اود ان اشكر اخي جمال السيد فهو من اعطاني بذرة الفكرة ودفعني للبحث للوصول لهذا النتائج الحمدلله الذي هدانا لهذا و ما كنا لنهتدي لو لا ان هدانا الله التطبيق القادم باذن الله انشاء قاعدة بيانات SQL وتصدير كافة الجداول لها بواسطة الكود (بدون استخدام معالج التكبير)

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

بسم الله الرحمن الرحيم " الْحَمْدُ لِلّهِ الَّذِي هَدَانَا لِهَذَا وَمَا كُنَّا لِنَهْتَدِيَ لَوْلا أَنْ هَدَانَا اللّهُ " ============================================================ برنامج الكنترول المدرسى 2017 من فضلك أكمل قراءة الموضوع ــ روابط التحميل آخر الموضوع نبذة عن البرنامج أولاً ـ تم تصميم وإعداد هذا البرنامج باستخدام Office 2010 ، لذلك فالبرنامج لا يعمل على Office 2003 ثانيًا ـ يعتبر هذا البرنامج الاصدار الثانى بعد نجاح الاصدار الأول بفضل الله ـ عز وجل ـ و الذى أعجب به كثير من رواد الكنترولات لبساطته وسهولة التعامل معه ولكن وجد به بعض التعديلات التى وجبت علىّ متابعتها وتعديلها وإظهار الأفضل والأدق ، فكان هذا الاصدار الثانى . الجديد في هذا الاصدار : 1ـ استخدام تصميمات جذابة سواء في أوراق العمل أو في وجهات البرنامج المختلفة . 2ـ يتم الانتقال بين أوراق الكنترول باستخدام أزرار داخلية المساعدة و من خلال الوجهات للدخول غلى أوراق العمل . 3 ـ تم تخصيص ورقة لتجهيز وإعداد وضبط وفرز أسماء التلاميذ وترتيبهم ابجديا ( الذكور أولا ) أو ( الإناث أولا) يتم الترحيل منها إلى البيانات الأساسية للطلاب 4ـ وتم إضافة خيار جديد داخل قائمة ( حالة الطالب ) وهو منقطع العام السابق إذا كان الطالب غائب عن الامتحان العام السابق فقط ( منقطع عام واحد ) وذلك لحساب عدد الطلاب الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 5 ـ في كثير من أوراق العمل متابعة تعليمات التشغيل من خلال ( ملاحظات ) موجودة داخل كل ورقة عمل . 6 ـ وجود إحصائيات داخل أوراق العمل للمساعدة مسئول الكنترول على متابعة العمل. أولا بأول 7ـ كشوف المناداة يحتوى كل كشف على لجنتين من نفس الصف الدراسى . 8 ـ الجدول وأرقام الجلوس : يوجد بالجدول الأول بالورقة قوائم منسدلة لملء بيانات الجدول فمثلا : خانة اليوم .... اضغط ستجد قائمة بأيام الأسبوع. خانة المادة ... اضغط ستجد قائمة بأسماء المواد الدراسية . خانة الزمن .. اضغط ستجد قائمة بأوقات الامتحان المتاحة . 9 ـ يتم ترحيل الطلاب الراسبين أو الناجحين تلقائيًا إلى أوراق منفصلة بهم خاصة 10 ـ زادت دقـــة الاحصائيات عن الاصدار الأول وتعديل ما بها من قصور بسيط . 11 ـ تم استخراج نسبة 65 % للطلاب الناجحين للمواد مرفقة داخل ورقة الاحصاء . 12 ـ تم تعديل شروط الحصول على الأوائل لتكون أكثر دقــة وذلك بالشروط المنصوص عليها وهى : الأكبر مجموع ثم الأصغر سنا في حالة تساوى المجموع ثم الترتيب الأبجدى في حالة تساوى المجموع والسن . ـ وظهور كلمة مكرر في حالة التساوى . 13 ـ يمكن التحكم في عدد الأوائل 30 أو 20 أو 10 حسب الرغبة وذلك باستخدام أزرار معينة موجودة بورقة العمل . 14 ـ تم تعديل هيكل تصميم الشهادات ليوافق التصميم المتعارف عليه والمنصوص عليه . 15 ـ يمكن الحصول على شهادات بأكثر من شكل كما يلى :_ __ شهادة التيرم الأول بمجموع المواد الأساسية فقط __ شهادة التيرم الأول بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الأول بدجات الامتحان التحريرى ـ __ شهادة التيرم الثانى بمجموع المواد الأساسية فقط __ شهادة التيرم الثانى بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الثانى بدجات الامتحان التحريرى ـ 16 ـ : الدور الثانى : _ يتم ترحيل البيانات من شيت راسبين آخر العام إلى ورقة البيانات الأساسية للطلاب الدور الثانى تلقائيا . 17 ـ يتم ترحيل الدرجات الناجحة فقط إلى كشف رصد الامتحان التحريرى الدور الثانى ويتبقى خانات فارغة التى تخص الدرجات الراسبة التى يتم الامتحان فيها ورصدها . 18 ـ يوجد إحصاء ختامى لنهاية العام الدراسى . 19 ـ يوجد أوراق منفصلة كل على حده لما يأتى : _ أ ـ كشف الناجحين بعد الدور الثانى . ب ـ كشف الراسبين بعد الدور الثانى . ج ـ كشف المنقولين بحكم القانون بعد الدور الثانى . د ـ كشف الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 20 ـ تم إضافة أوراق جديدة للكنترول للمساعدة على أداء العمل : وهذه الأوراق هى أ ـ كشف إجمال براسبين التيرم الثانى لتوقيع ولى الأمر بالعلم . ب ـ إخطار ولى الأمر رسميا من المدرسة بالدور الثانى للطالب . ج ـ أوراق خاصة برئيس الكنترول ( تشكيل لجنة الكنترول ـ إقرار موانع الامتحان ـ تعليمات سير الامتحانات ) . د ـ محضر فتح مظاريف أوراق الأسئلة . هـ ـ محضر فتح / غلق الكنترول . و ـ محضر تصحيح أوراق الاجابة . ز ـ كشف إجمالى بتوزيع اللجان من الصف الأول إلى الصف الخامس ( خاص بالكنترول ) =================================================================== وأخيـــــــــــــرًا فى حالة وجود أى قصور أو مقترحات واستفسارات عن البرنامج يرجى التواصل معنا عبر خطوط التواصل المختلفة سواء أرقام الهاتف المحمول أو البريد الإلكترونى أو الصفحة الرئيسية على موقع التواصل الاجتماعى الفيس بوك ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ مع تحياتى محمد إبراهيم الدسوقى معلم أول ( أ ) حاسب آلى محافظة الغربية ـ إدارة سمنود التعليمية مدرسة أم المؤمنين الابتدائية ـ بالراهبين 01125915740 // 01274757320 @@@@@@@@@@@@@@@@@@@@@@@ E.mail : me.100100@yahoo.com Facebook_Pro. : Mohamed Eldesoky @@@@@@@@@@@@@@@@@@@@@@@ والآن مع روابط التحميل : الصف الأول الابتدائى هنــا الصف الثانى الابتدائى هنــا الصف الثالث الابتدائى هنــا الصف الرابع الابتدائى هنــا الصف الخامس الابتدائى هنــا @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ السلام عليكم ورحمة الله

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

بسم الله الرحمن الرحيم هنا سيتم تجميع ما يخص اكسس وارتباطه بقواعد البيانات الاخرى Link Access with Sql Server 2012 تمت كتابته بواسطة ابو محمد تطوير نموذج التقييم للعمل اونلاين دون الحاجة الى ارسال ميل تمت كتابته بواسطة السيد جمال ربط قاعدة البيانات باستضافة على الشبكة والتحكم بها من اي مكان في العالم للسيد جمال http://www.officena.net/ib/index.php?showtopic=61514 تحويل قاعدة بيانات من اكسس الى SQL تمت كتابته بواسطة محمد أيمن استخراج اسم سيرفر SQL وتحديد قاعدة بيانات للارتباط بها تمت كتابته بواسطة محمد أيمن

السلام عليكم ورحمة الله وبركاته كود البحث المتقدم باستخدام المصفوفات VBA Arrays قدم لنا الأخ الغالي ياسر العربي صاحب الجولات والصولات كود رائع ، ويستخدم الكود في البحث المتقدم ، وقد استخدم المصفوفات والتي هي عشقي في التعامل مع الأكواد ، حيث يتم تنفيذ جميع أسطر الكود بالذاكرة بعيداً عن التعامل بشكل مباشر مع ورقة العمل ، مما يجعل الكود أسرع مئات المرات من استخدام الحلقات التكرارية العادية. وقد ارتأيت أن أقوم بشرح لأسطر الكود ليكون مرجع لكل طالب علم ولكل باحث في هذا الخصوص ، ولنبدأ مرحلة جديدة من عالم الأكواد باستخدام المصفوفات VBA Arrays ، لما لها من مرونة عالية وسرعة فائقة في تنفيذ الأكواد. يوجد بالمرفق ورقتي عمل أحدهما باسم Data وفيها البيانات الخام من 14 عمود ، والورقة الأخرى باسم Result للنتائج وبها الخلية G2 والتي توضع بها نص الكلمة المراد البحث عنها. وإليكم الكود مع الشرح بالتفصيل (وضعت مثال بسيط ليستطيع المتتبع للشرح فهم الكود بسهولة) Sub Araby_Search() 'تعريف المتغير لورقة العمل التي تحتوي على البيانات الخام Dim wsData As Worksheet 'تعريف المتغير لورقة العمـل المطلـوب إظهـار النتائـج بها Dim wsResult As Worksheet 'تعريف المتغير ليحمل قيم المصفـوفة للبيانات الخـام Dim Arr As Variant 'تعريف المتغير ليحمل قيم المصفوفة للنتائج المطلوبة Dim Temp As Variant 'تعريـف المتغير من النـوع النصي ليحمـل قيمة أو نص البحث 'أي الكلمة المطلوب البحث عنها يتم تخزينها في هذا المتغير Dim strSearch As String 'تعريف المتغير وسيستخدم في الحلقة التكرارية لصفوف المصفوفة Dim I As Long 'تعريف المتغير وسيستخدم في الحلقة التكرارية لأعمدة المصفوفة Dim J As Long 'تعريف المتغير وسيستخدم في مصفوفة النتائج لزيادة مقدار الصفوف بمقدار واحد Dim P As Long 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تحتوي '[Data] على البيانات الخام المطلوب معالجتها والمسماة Set wsData = Worksheets("Data") 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تريد إظهار '[G2] النتائج بها بمجرد إدخال قيمة أو نص محدد في الخلية Set wsResult = Worksheets("Result") 'مسح النطاق الذي توضع فيه النتائج استعداداً لوضع النتائج الجديدة wsResult.Range("A8:N10000").ClearContents '[G2] تعيين قيمة للمتغير ليساوي قيمة الخلية 'وهي الخلية التي ستوضع فيها نص الكلمة المطلوب البحث عنها strSearch = wsResult.Range("G2").Value 'تعيين قيمـة للمتغير ليحمل قيم النطاق بالكامل للبيانات الخام ' وذلك [Data] حيث أن مصـدر البيانات الخام ورقة العمل المسماة 'عند [N] وينتهي في العمود [A5] في النطاق الذي يبدأ من الخلية '[&] آخـر صف به بيانات ، ويتم تحديده عن طريـق الجزء بعد علامـة Arr = wsData.Range("A5:N" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value 'والتي ستحمل قيم النتائج [Temp] إعادة تعيين أبعاد المصفوفة المسماة '[Arr] وتكون بنفس أبعاد المصفوفة التي تحمل البيانات الخام والمسماة 'سنعتبر المصفوفة أشبـه بالصفـوف والأعمدة حيث الرقـم 1 يمثـل الصفـوف 'بإرجاع أكبر قيمة [UBound]بينما الرقم 2 يمثل الأعمدة ، وتقوم الكلمة 'أبعاد المصفوفة في هذه الحالة >> '------------------------------- 'البعد الأول سيكون من 1 إلى أكبر قيمة للصفوف 'البعد الثاني سيكون من 1 إلى أكبر قيمة للأعمدة ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) 'حلقة تكرارية من الصف الأول للمصفوفة إلى آخر صف بها For I = 1 To UBound(Arr, 1) 'إذا كان النص المطلوب البحث عنه فارغ يتم الخروج من تنفيذ الكود If strSearch = "" Then Exit Sub 'هذا السطر هو أهم سطر بالكود حيث هو الشرط الذي من خلاله 'والشرط [Temp] ستوضع النتائج في مصفوفة النتائج المسماة 'هـو تطابق قيمة المصفوفة في صف الحلقة في العمود رقم 14 'حيث يمثـل الرقم 14 العمود داخـل مصفوفة البيانات الخام '[strSearch] يتـم اختبـار التطابـق مع نـص البحث المسمى If Arr(I, 14) Like "*" & strSearch & "*" Then 'زيادة مقدار المتغير بمقدار 1 'فائدة المتغير هنا هو أنه مع كل حلقة تكرارية 'إذا تحقق الشرط فقط يزيد المتغير بمقدار واحد 'ليمثل هذا المتغير صفوف مصفوفة النتائج الجديدة P = P + 1 'حلقة تكرارية داخلية من العمود الأول للمصفوفة إلى آخر عمود بها For J = 1 To UBound(Arr, 2) 'تعبئـة مصفـوفة النتائـج بالبيانات مـن مصفوفة البيانات الخام '[Temp]مثـال لتتضح صورة كيفية تعبئة المصفوفة الجديدة المسماة 'في أول حلقـة سيكون مقداره 1 ويمثل أول صف [P] المتغيـر المسمى 'أول صف هنا لمصفوفة النتائج 'في أول حلقة سيكون مقداره 1 ويمثل أول عمود [J] المتغير المسمى 'في أول حلقة سيكون مقداره 1 ويمثل أول صف [I] المتغير المسمى 'أول صف هنا لمصفوفة البيانات الخام Temp(P, J) = Arr(I, J) 'الانتقال للحلقة التالية للأعمدة Next J 'نهاية جملة الشرط وهو تطابق نص البحث مع العمود رقم 14 في المصفوفة End If 'الانتقال للحلقة التالية في صفوف مصفوفة البيانات الخام Next I 'إذا كانت قيمة المتغير أكبر من صفر فهذا يعني أنه تم إيجاد نتائج للبحث 'حيث أن زيادة المتغير كما أوضحنا مقرونة بتحقق الشرط وطالما تحقق الشرط 'فهذا يعني أن مصفوفة النتائج سيكون بها بيانات ومن ثم يتحقق الجزء الثاني '[A8] وضع نتائج مصفوفة النتائج في أول خلية في ورقة النتائج في الخلية '[P] ويتم تمديد النطاق بمقدار عدد الصفوف طبقاً لقيمة المتغير المسمى '[Temp] وبمقدار عدد الأعمدة طبقاً لأكبر عدد لأعمدة المصفوفة المسماة If P > 0 Then wsResult.Range("A8").Resize(P, UBound(Temp, 2)).Value = Temp End Sub لتحميل الملف المرفق وللإطلاع على الموضوع الأصلي قم بزيارة الرابط التالي رابط الموضوع من هنا

افتح ايميل اذا عندك على GMAIL ثم اضغط او افتح هذا الموقع تابع لـ GOOGLE اضغط هنا وستجد خاصية في الاعلى تحرير النصوص " SLIDES"افتحه ثم اكتب ما تريد في ملفك بعد رفعه ثم احفظه لعله يستجيب او يوجد محررات الاوفيس على اونلاين

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

لم اجرب على 2007 او اصدار اعلى فلعل بعض الاخوة ممن جرب يفيدك في هذا ولكن يمكنك التجربة : ابحث في الكود عن mdb واستبدلها بــ accdb

الله الله انا لا اصدق. هل يمكن عمل ذلك ايضا متابع معك باذن الله واود ان اشكرك.. شكرا جزيلا.. وبارك الله فيك واستحملني عشان هسأل كتييير

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

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تم ارفاق ملف الموضوع من الفاضل _ أ / ياسر العربى تفضلوا عرض صور المنتج و معلوماته داخل يوزر فورم http://yasserelaraby86.blogspot.com.eg/2016/10/blog-post_6.html و لا تنسونا من صالح الدعاء

ابا جودى الف الف شكر اشكر لك تفاعلك لازلت بصدد التجريب ؟ لكن هل هنالك طريقة للتحكم بعرض وارتفاع الصورة ؟

شكرا لك أخي أبويحيى أخي ياسر حاولت تطبيق الفكرة بدون الفيجوال فخرجت بهذا : عمل ارتباط تشعبي يعطيك آخر خليه انتقال الارتباط التشعبي2.rar

ياسر خليل أبو البراء اخى الفاضل تحياتى

السلام عليكم اولا قم بتحويل المعادلة الموجودة في الخلية A1 بهذا الشكل =IFERROR(VLOOKUP(Sel;M4:N8;2;0);"") ثانيا غير الكود السابق بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Range("A1") = 0 Then GoTo 100 If Range("A1") = "" Then GoTo 200 If Target.Address = Range("A2").Address Then _ Range("A3:K21").AutoFilter Field:=1, Criteria1:="=" & Range("A1") Exit Sub 100 Range("A3:K21").AutoFilter Field:=1, Criteria1:="<>" & "" Exit Sub 200 Range("A3:K21").AutoFilter End Sub ============== عندما تريد رؤية كل البيانات بما فيها الصفوف الفارغة إمسح الخلية التي تختارمنها الشركات ( A2 ) التي اسمها Sel

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

الامر يسير والحل انت ذكرته اجعل الاطار ظاهر ... وماله الاطار .. حلو وجميل ويمكن تثبت شعارك عليه بدل شعار اكسس

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

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

ان شاءالله ساقوم بنشر شرح يخص الموضوع ... مع تحياتي

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

الأخوة الكرام أعضاء المنتدى .. السلام عليكم ورحمة الله وبركاته هذا و نزولا على رغبتكم بترك نسخة مجانية بدون تشفير للتعليم ، لوجه الله تعالى وإن كنت أرى أننى لم أقدم الجديد فى هذا المجال بالقياس إلى علمكم الواسع الذى اقف أمامه عاجزا على محاكاته فهذا رابط تحميل نسخة من البرنامج http://up.top4top.net/downloadf-283g1ra1-rar.html ولكم منى جميعا فائق الاحترام والتقدير اساتذتى الكرام

مشكور اخوي كلامك صحيح زبطت المعادلة

تفضل copy txt val.rar

استغمل هذه المعادلة =VLOOKUP($T5,{0,"متعثر";0.2,"متأخر";0.5,"منتظم";1,"انتهى"},2)

=IF(Q5=100%;"منتهى";IF(T5>=50%;"متعثر";IF(T5>=20%;"متأخر";"منتظم")))

ماشاء الله تبارك الله كود سريع جدا

وعليكم السلام اخي الكريم اين الملف المرفق؟

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة البحث فى لست بوكس وترحيله لورقة معينة تم ارفاق المشاركه من الفاضل _ أ / عمرو.محمد 11 Amr.rar مع شرح الكود Private Sub TextBox1_Change() 'اخر الكريم تقبل تحياتى وهذا شرح بسيط بالعامية المصرية والبلدى كدة بدون التطرق للشرح العملى 'للمتغيرات والمعادلات لان هذا يطول شرحة وستجد ما طلبت اذا بحثت بالمنتدى الرائع اوفيسنا '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' السطر القادم لتفادى اى خطأ فى الكود ومنع اظهار رسالة ال debug للمستخدم On Error Resume Next ' بقوله افرغ محتويات الليست بوكس علشان لما تفتح الليست المرة القادمة متلاقيش البيانات المبحوث عنها المرة اللى فاتت موجودة ListBox1.Clear ' متغيرات لاسم الصفحة والصفوف Dim ws As Worksheet Set ws = Sheets("data") Dim i As Long Dim v As Integer 'بقوله هنا لو التكست بوكس اللى ببحث فيه مش فاضى نفذ اللى جاى If Me.TextBox1.Text <> "" Then '================================================ 'هنا بقوله لو اتكتب فى التكست بوكس من غير ما تعلم على نوع البحث من التلات خيارات يطلعلك رسالة تنبيه انك لابد ان تختار اولا 'ويوقف تنفيذ باقى الكود If Me.esm.Value = False And Me.ra2eesy.Value = False And far3y.Value = False Then MsgBox "رجاء اختر نوع البحث اولا" Me.TextBox1 = "" Exit Sub End If '============================================== 'هنا بقى متغير اسمه lr وده بيحددلى اخر صف فيه بيانات فى العمود lr = ws.Range("b" & Rows.Count).End(xlUp).Row ' بقوله من الصف الخامس لغاية اخر صف فيه بيانات نفذ اللى جاى ' وديه اسمها حلقة تكرارية For i = 5 To lr ' هنا متغيرات لتحديد الصفوف المبحوث بها سواء بالاسم او الفرعى او الرئيسي comp = ws.Cells(i, "b") 'اسم comp2 = ws.Cells(i, "c") 'فرعى comp3 = ws.Cells(i, "d") 'رئيسي If ws.Cells(i, 1) <> "" Then '============================================================ 'لو البحث بالاسم هو اللى متحدد كومب هتبقي زى ماهى وهيبقى عمود البحث هو b If Me.esm.Value = True Then comp = comp End If 'هنا لو الفرعى هو المتحدد كومب هتساوى كومب 2 اللى هو عمود البحث بالفرعى If Me.far3y.Value = True Then comp = comp2 End If 'كذلك الامر هنا If Me.ra2eesy.Value = True Then comp = comp3 End If '============================================================ ' اللى فات هنستخدمه هنا فى داله البحث باى حرف فى الكلمة من غير شرح كتير علشان يطول الشرح ' اللى يشغلك فيها كومب اللى احنا معرفينه فوق وهو نطاق البحث 'واللى انت هتبحث فيه وهو التكست بوكس 'وهيقارن اللى كتبته فى التكست بوكس بالبيانات اللى فى نطاق البحث If InStr(1, comp, Me.TextBox1.Text, vbTextCompare) Then ' هنا بقوله لما تلاقى بيانات البحث ضيفها فى الليست بوكس ListBox1.AddItem 'v ده متغير زى i وده للصفوف 'الليست بتبتدى من الشمال لليمين وهما اربع صفوف (v,0) معناها الصف v اللى هيتكرر لو فى اكتر من نتيجة للبحث 'و zero معناها العمود الاول فى الليست من الشمال وهكذا ' وهنا بقوله ضيف نتائج البحث فى العمود 1 والصف i فى العمود التالت والصف v فى الليست بزكس وهكذا Me.ListBox1.List(v, 3) = ws.Cells(i, 1).Value 'مسلسل Me.ListBox1.List(v, 2) = ws.Cells(i, 2).Value 'اسم Me.ListBox1.List(v, 1) = ws.Cells(i, 3).Value 'حساب فرعى Me.ListBox1.List(v, 0) = ws.Cells(i, 4).Value 'رئيسي 'وديه علشان لو اكتر من نتيجة للبحث تتكرر ولو مكتبتهاش هيجيبلك نتيجة واحدة فقط v = v + 1 ' اقفل معادلات if End If End If ' اقفل الحلقة التكرارية for i = 5 to lr Next i 'ولو الليست بوس فاضية مفيهاش صفوف او عدد صفوفها 0 امسحها علشان نتايج البحث السابقة متفضلش موجودة If Me.ListBox1.ListCount = 0 Then Me.ListBox1.Clear End If 'كل اللى فات هيحصل لو التكست بوكش مش فاضى طيب لو فاضي امسح الليست بوكس Else Me.ListBox1.Clear 'اقفل قاعدة if End If End Sub و لا تنسونا من صالح الدعاء

بارك الله فيك أبو عيد سؤال هل الارتباط يمكن أن يرتبط بآخر خلية بعمود محدد ..؟؟ لدي فكرة يمكن تنفيذها ولكن سيكون العمل على عمود محدد أي سيتم الانتقال إلى آخر خلية بها بيانات في العمود المحدد بمجرد النقر على الارتباط التشعبي

عمل رائع تستحق الشكر وارجو دمج اليوم فيها

تفضل جرب المرفق انتقال الارتباط التشعبي1.rar

قمت بربط كود تطبيق الوارد اولا صادر اولا على ملف الاخ الفرس في شيت مستقل ويتم التنقل بين الاصناف عن طريق قائمة منسدلة يختار منها الكود مراقبة المخزون.rar

جزاك الله خيرا براك الله فيك

عمل ممتاز شكرا

الزبارى جزاك الله خيرا دايما موضوعاتك ديجيتال تحياتى

السلام عليكم ورحمة الله وبركاته أخي الزباري المحترم أعمالك متقنة ورائعة كالعادة بارك الله بكم وجزاكم الله خيراً والسلام عليكم ورحمة الله وبركاته

مشكور استاذنا / بن عليه واليكم الملف باي شرط مع شرط التاريخ تقبلو تحياتي SERCH_ARRY_YASSER_ELARABY1.rar

جزاك الله كل خير عمل جميل ورائع .

جزاك الله خير

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

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

السلام عليكم و رحمة الله و بركاته اخواني الاحباب بالمنتدي اقدم لكم برنامج يصلح لحسابات المخازن ( مخازن شكائر " أجوله " ) و ارجو من الله يفيدكم و أسألكم يا اخواني الدعاء لي بظهر الغيب و أسألكم أن تدعوا لي ان يفرج الله عني ما انا فيه و ان يرزقني الرزق الواسع الحلال الطيب المبارك و الله المستعان. و السلام عليكم و رحمة الله و بركاته BAGS --.rar

12/11/2009 طريقة عمل البرنامج 1- تسجيل بيانات العميلالدخول الى صفحة العملاء و تسجيل بيانات العميل - غير قابل لتكرار اسم العميل 2- توزيع الأقساطالدخول الى ورقة توزيع الأقساط ثم يتم ادخال البيانات كاملةبمجرد ادخال البيانات تظهر لك النتائج في الجدول الأيسر 3- اضغط على زر حفظ بيانات الأقساط - سوف يتم حفظ البيانات في ورقة الأقساط و منها تجد اجمالي المبالغ المطلوبة من العميل قد ظهرت في ورقة بيانات العملاء 4-الدخول الى ورقة السندادخل اسم العميل - سوف تظهر لك قائمة منسدلة بأسماء الأجهزة التي تم عمل اقساط لها لهذا العميل تختار منها الجهاز او السلعة المطلوبة بعد ادخال اسم العميل و نوع الجهاز تظهر لك قائمة منسدلة بـ أول قسطين مطلوب سدادهما من العميل تختار منها ماتريدتقوم بتسجيل المبلغ - و هنا تستطيع تسجيل أي مبلغ اقل من او يساوي قيمة القسط المختار او مطلوب سداده بعد اكتمال بيانات السند تختار طـبـاعة الـسـنـدبعد طباعة السند تلقائيا سوف يتم تسجيل المبلغ في العمود A امام العميل في ورقة توزيع الأقساط - ويتم حفظ كامل بيانات السند في ورقة حفظ البيانات السداد - الآن لدينا في ورقة بيانات العملاء عمود الأقساط المتأخرة - هنا يتم حساب كل الأقساط المطلوبة من هذا العميل قبل تاريخ اليوم و يخصم منها اجمالي المبالغ المسددة من العميل الآن تستطيع استخدام الملف و استخراج النتائج منه مع تحياتي للجميع 4_توزيع_الأقساط_ومتابعتهاQest.rar

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