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

جميل جداً .. شكراً لك على هذه المعلومة انا فعلاً وجدت في جوجل الموقع ده ، والرابط للخدمة :- https://www.everythingaccess.com/mdeconversion.asp أما موضوع اثبات الملكية ، يعني لازم أحلف لهم يمين مثلاً هههههههه ولا إيه بالضبط

السلام عليكم تم عمل الاحصائيات الملف المرفق به الاحصاء Plateform3.xlsb الشريط المتحرك ليس لدي جلفية لعملة ولا اراه مهما لانه سيسبب ثقل للملف ا1ذا تحققت طلباتك ارجو فتح موضوع جديد لاي طلب جديد وهذا حسب قوانين المنتدى

الفكرة الجديدة عمل اكثر من نموذج بحث فى قاعدة البيانات نموذج اعدادت بحث للتحكم فى نماذج البحث المختلفة يتم من خلالة عمل ما يلى: تحديد اسم نموذج البحث تحديد مصدر بيانات نموذج البحث سواء كان جدول او استعلان من مربع قيم تحديد حقل او اكثر من حقل لاجراء عملية البحث داخل البيانات لهذا الحقل/الحقول المختارة تطبيق تلوين نتائج البحث ثورة فكرية فى عمل محرك بحث متقدم متعدد الاستخدامات بطرق بحث مختلفة فى النهاية سعدت جدا جدا جدا بالاطلاع على كنز الافكار الموجودة فى المنتدى والقيام بعملية تطويره هذه الافكار فى انتظار ارائكم بالرد بعد التجربة UniversalSearch Pro v2.01.accdb

الفكرو المجنونة فى هذا الموضوع

قم بإزالة علامتي التنصيص حول كلمة red لتصبح بهذا الشكل <font color=red> بدلاً من هذا <font color='red'> تحياتي

وعليكم السلام ورحمة الله 🙂 باستخدام هذه الأداة : Private Sub cmdPrint_Click() On Error GoTo Err_cmdPrint_Click Dim Index3 As Variant Dim repName As String Dim ftrName As String ' Declare ftrName, assuming it's a String for the filter argument. ' Check if any items are selected from the listbox. If L3.ItemsSelected.Count = 0 Then MsgBox "لا يوجد مطبوغات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه " Exit Sub End If ' Loop through each selected item and open the corresponding report. For Each Index3 In L3.ItemsSelected repName = L3.ItemData(Index3) repName = "تقرير_" & repName DoCmd.OpenReport repName, acViewNormal, , ftrName Next Index3 Exit_cmdPrint_Click: Exit Sub Err_cmdPrint_Click: MsgBox Err.Description Resume Exit_cmdPrint_Click End Sub مع اختيار : والتعليمات نفس رسالتك مع تغيير بسيط : الكود التالى يعمل بدون مشاكل ولكن هناك سطور مكررة متداخلة به يرجى ضبط بناء الكود لاختصاره وتحسينه

بحث متعدد امكانية اختيار حقل او حقول بحث من خلال كود مركزى فى وحدة نمطية لتطبيق فكرة البحث فى اكثر من نموذج أقدم لكم وحدة نمطية عامة جاهزة للاستخدام تحول اى نموذج إلى محرك بحث تفاعلى بمميزات احترافية تدعم: البحث فوري أثناء الكتابة (Search As You Type) تلوين HTML للكلمات المطابقة للنتائج بلون أحمر <font color=red> بحث متعدد الحقول بحث متعدد الكلمات دعم كامل للحالات المتقدمة "ط" ← تلوين "ط" في كل الحقول "ط ر ة" ← تلوين "ط" + "ر" + "ة" مع فلتر AND "ط " ← مسافة محفوظة (تلوين فقط) Backspace/Delete ← فلتر يتجدد النقر المزدوج - Double Click ← مسح فورى بحث بدون نتائج ← رسالة + إلغاء فى حالة عدم وجود نتائج الوحدة النمطية العامة مثلا باسم : modMultipleSearchHighlights Option Compare Database Option Explicit Private Const CTRL_PREFIX As String = "txt" Public Sub InitUniversalSearch(frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String For i = 0 To UBound(arr) fld = Trim(arr(i)) frm.Controls(CTRL_PREFIX & fld).ControlSource = "=[" & fld & "]" Next i Exit Sub ErrHandler: MsgBox "خطأ في InitUniversalSearch: " & Err.Number & " - " & Err.Description & vbCrLf & "الحقل: " & CTRL_PREFIX & fld, vbCritical, "خطأ في البحث" End Sub Public Sub UpdateSearch(txtBox As TextBox, frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim searchValue As String Dim currentPos As Long searchValue = txtBox.text currentPos = Len(searchValue) If Len(searchValue) = 0 Then ResetAllHighlights frm, fieldNames frm.FilterOn = False ElseIf Right(searchValue, 1) = " " Then ApplyHighlightsOnly frm, fieldNames, searchValue Else ApplyHighlightsOnly frm, fieldNames, searchValue frm.Filter = BuildFilterSQL(fieldNames, searchValue) frm.FilterOn = True If frm.Recordset.RecordCount = 0 Then MsgBox "لا توجد نتائج لـ """ & searchValue & """" & vbCrLf & "عدد السجلات: 0", vbInformation, "نتائج البحث" frm.FilterOn = False End If End If Dim wasFocused As Boolean: wasFocused = (Screen.ActiveControl.name = txtBox.name) txtBox.SetFocus txtBox.SelStart = currentPos txtBox.SelLength = 0 If Not wasFocused Then Screen.PreviousControl.SetFocus Exit Sub ErrHandler: Select Case Err.Number Case 2185 Debug.Print "UpdateSearch 2185 ignored: " & Err.Description Resume Next Case 2474, 6139 Debug.Print "UpdateSearch ignored: " & Err.Number & " - " & Err.Description Resume Next Case Else Debug.Print "UpdateSearch Error: " & Err.Number & " - " & Err.Description MsgBox "خطأ في البحث: " & Err.Number & vbCrLf & Err.Description, vbCritical Resume ExitHandler End Select Resume Next ExitHandler: End Sub Private Function ReplaceMultiple(inputText As String) As String Dim result As String: result = inputText result = Replace(result, "'", "''") result = Replace(result, "[", "[[]") result = Replace(result, "?", "[?]") result = Replace(result, "*", "[*]") result = Replace(result, """", """""") ReplaceMultiple = result End Function Private Sub ApplyHighlightsOnly(frm As Form, fieldNames As String, searchText As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim i As Integer, w As Integer, fld As String Dim ctrl As Control, expr As String, safeWord As String On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler expr = "Nz([" & fld & "], """")" For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) expr = "Replace(" & expr & ",""" & safeWord & """,""<font color=red>" & safeWord & "</font>"")" End If Next w ctrl.ControlSource = "=IIf(Len(" & expr & ")>0, " & expr & ", """")" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ApplyHighlightsOnly Error: " & Err.Number & " - " & Err.Description & " (Field: " & fld & ")" End Sub Private Sub ResetAllHighlights(frm As Form, fieldNames As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String, ctrl As Control On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler ctrl.ControlSource = "=[" & fld & "]" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ResetAllHighlights Error: " & Err.Number & " - " & Err.Description End End Sub Private Function BuildFilterSQL(fieldNames As String, searchText As String) As String On Error GoTo ErrHandler Dim arrFields() As String: arrFields = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim conditions As String, i As Integer, w As Integer Dim wordCond As String, safeWord As String For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) wordCond = "" For i = 0 To UBound(arrFields) If i > 0 Then wordCond = wordCond & " OR " wordCond = wordCond & "[" & Trim(arrFields(i)) & "] Like '*" & safeWord & "*'" Next i If Len(conditions) > 0 Then conditions = conditions & " AND " conditions = conditions & "(" & wordCond & ")" End If Next w BuildFilterSQL = IIf(Len(conditions) = 0, "", conditions) Exit Function ErrHandler: BuildFilterSQL = "" Debug.Print "BuildFilterSQL Error: " & Err.Number & " - " & Err.Description End Function إعدادات النموذج المطلوبة مربع نص البحث باسم : txtSearch مربعات نص الحقول المطلوب البحث بداخلها : يجب ان تكون غير منضمة : Unbound يجب ان تكون Rich Text يجب ان تكون بنفس اسم الحقل تماما وتسبقها البادئة : txt فمثلا فى المرفق الحقول المطلوب البحث بداخلها كانت باسم :item_na, class_no اذن اسماء مربعات النص فى النموذج لتلك الحقول سوف تكون بالاسماء: txtitem_na, txtclass_no مصدر بيانات النموذج (Record Source) :اسم الجدول او استعلام للجدول عادى Query/Table الاكواد المطلوبة فى النموذج ثابت لادراج اسماء الحقول المراد البحث بداخلها مثل Private Const strUniversalfieldNames As String = "item_na,class_no" وفى حدث تحميل النموذج Private Sub Form_Load() InitUniversalSearch Me, strUniversalfieldNames End Sub أحداث مربع النص الخاص بالبحث : txtSearch يمكن استخدام حدث عند التغيير (Change) أو حدث بعد التحديث (AfterUpdate) ولكن الافضل فى السرعة والاداء خاصة مع كثرة عدد السجلات او عند استخدام التطبيق فى شبكة محلية لضمان الكفائة فى الاداء والسرعة يفضل استخدام الكود التالى فى حدث بعد التحديث (AfterUpdate) UpdateSearch Me.txtSearch, Me, strUniversalfieldNames ولكن انا فقط فى المرفق استخدمت حدث عند التغيير لرؤية النتيجة فورية فقط وبعد ذلك يمكن عمل زر امر لعمل مسح للفلاتر ولمربع النص او كود فى حدث النقر المزدوج لمربع البحث : txtSearch Me.txtSearch.Value = "" UpdateSearch Me.txtSearch, Me, strUniversalfieldNames واخيرا المرفق Search Highlights.accdb

اهلا استاذ سعيد جدا بمرورك واسعدتنى كلماتك واكثر ما اسعدنى هو اعجابك بهذا الجنون

راااائع والله تطبيق عبقري لفكرة مجنونة كما أسميتها

أنا جربت التعديل الأخير UniversalSearch Pro v2.01 وهو رائع حقاً. . وأقترح في نموذج الاعدادات: frmSearchSettings وجود إمكانية لظهور حقول الجدول مصدر البيانات بتسميات اخرى على اعتبار أن المستخدم ربما لا يعلم مدلول اسماء الحقول. أو ظهورها كما تم تسميتها في خصائص الحقل: Caption فمثلا تظهر : كود الصنف اسم الصنف مجموعة الصنف رصيد الصنف بدلا من : item_id item_na class_no item_balance .

اعرض الملف أداة إنشاء لوحة رئيسية مخصصة {سلسلة الأدوات المساعدة المخصصة} قد يكون من أهم إستخدامات كائن الشجرة Treeview هو إستخدامها في شجرة الحسابات أو الهياكل التنظيمية ولكن يوحد لهذا الكائن وظيفة هامة أخرى وهي إستخدامه في شاشة لوحة التبديل أو شاشة التنقل الرئيسية Switchboard لذا وبإستخدام الأداة المرفوعة سابقاً في هذا الموضوع يمكننا الحصول على أكثر من شكل لشاشة لوحة التبديل الرئيسية . يتم من خلال الأمثلة المرفقة وعند النقر على عناصر الشجرة القيام بأحدى الوظائف التالية - فتح نموذج بشكل طبيعي (أو كنموذج فرعي عند إستخدام لوحة التبديل الجانبية) مع إمكانية إضافة معلمات لحاصية OpenArgs - فتح نموذج بشكل منبثق أو مشروط مع إمكانية إضافة معلمات لحاصية OpenArgs - فتح تقرير في وضع المعاينة مع إمكانية إضافة معلمات لحاصية OpenArgs - طباعة تقرير مباشرة مع إمكانية إضافة معلمات لحاصية OpenArgs - تشغيل إجراء عام (يجب أن يكون إجراء في وحدة نمطية ويجب أن يكون بدون معلمات) - إستدعاء دالة عامة (يجب أن تكون إجراء في وحدة نمطية مع أو بدون معلمات) ستجدون في المرفقات الملفات التالية : 1 - النموذج الأول لشاشة التبديل + القالب الخاص به في هذا المثال سنحصل على لوحة تبديل مستقلة يمكن إستخدامها كشاشة رئيسية للتطبيقات الخاصة 2 - النموذج الثاني لشاشة التبديل + القالب الخاص به في هذا المثال سنحصل على لوحة تبديل جانبية تقوم بفتح النماذج كنماذج فرعية ضمن الشاشة الرئيسية 3 - النموذج الثالث لشاشة التبديل + القالب الخاص به وهو نسخة مطابقة للنموذج الثاني ولكنها مخصصة لمن يستخدمون اللغة الإنجليزية في الواجهات الخاصة بهم لاتوجد أي تعليمات إضافية فآلية العمل هي نفسها الموضحة في الموضوع الخاص بإداة Treeview المخصصة ولكن سنجد هنا بعض الإضافات على النحو التالي - إظهار أيقونة تميز عناصر المستوى الأول عن بقية المستويات - تبديل أيقونتي الجمع والطرح بأشكال أخرى (لمن يحبون التغيير) - طريقة تحويل إتجاه الشجرة من اليسار إلى اليمين لمن يستخدمون اللغة الإنجليزية في تطبيقاتهم وهذا يعني أنه يمكننا القيام بنفس التعديلات على الأداة في الموضوع السابق للحصول على نفس النتائج هنا من المزايا الإضافية المقدمة مع الإداة أنه عند إستخدام النموذج الثاني أو الثالث سنجد كيف نقوم بإظهار شاشة عامة تحتوي على أيقونة وعنوان التطبيق وأي معلومات إضافية نرغب في إظهارها وتظهر هذه الشاشة عندما لايتم تحديد أي عنصر من القائمة أو أن تحديد العنصر لاينتج عنه فتح أي نموذج فرعي تحياتي صاحب الملف منتصر الانسي تمت الاضافه 03/04/26 الاقسام قسم الأكسيس  

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

* وظيفة LIKE تستخدم لمقارنة النصوص مع نمط (Pattern) معيّن. النمط يحتوي على رموز خاصة (Wildcards) تسمح بالبحث الجزئي أو المرن داخل النصوص. * أمثلة عملية في VBA Dim txt As String txt = "Mahdi" ' مثال 1: البحث عن نص يبدأ بـ "M" If txt Like "M*" Then MsgBox "يبدأ بحرف M" End If ' مثال 2: نص مكون من 5 أحرف بالضبط If txt Like "?????" Then MsgBox "النص يحتوي على 5 أحرف" End If ' مثال 3: نص ينتهي بـ "di" If txt Like "*di" Then MsgBox "ينتهي بـ di" End If ' مثال 4: نص يحتوي على رقمين متتاليين Dim code As String code = "AB12" If code Like "*##" Then MsgBox "ينتهي برقمين" End If

تم تعديل مثالك ليتم إظهار الجداول في القائمة وحذف بيانات الجدول المحدد وإعادة الترقيم من 1 نسخ قاعدة البيانات قبل الحدف.accdb

أعجز عن وصف شعوري بهذا الكلام من أستاذ كبير مثلك 🥰

وعليكم السلام ورحمة الله وبركاته اليك التعديل المطلوب Horaire1.xlsb

غفر الله ذنوبك كلها وعفا عنك وأحسن إليك ورزقك من حيث لا تحتسب .. لك ولوالديك وجميع أحبابك 😊🤲 وعدت فأوفيت .. وصنعت تحفة راااااائعة قمة في الجمال .

وتنفيذاً للوعد الذي وعدته للأخ @Moosak قمت بإضافة أداة مساعدة في إنشاء صيغ أوامر مربع الرسائل MsgBox إلى مكتبة الموقع

أعضاء المنتدى الكرام ... كل عام وانتم بخير ... إليكم أحبائي كنترول جدارات الصف الاول كامل مفتوح المصدر وبدون قيود داعيا الله ان يكون عملا خالصا لوجه تعالى وان يكون عملا ينتفع به الكنترول يشمل الآتي تنبيه : كنترول جدارات الصف الثاني جاري التحضير له ان شاء الله تعليمات الدخول لشاشة البرنامج 1- تحويل اللغة الى الانجليزية 2- التحويل الى حروف كبيرة Caps Lock 3- اكتب في المربع الاول بحروف عربية "بسم" 4- - اكتب في المربع الثاني بحروف عربية "الله" 5- اضغط تاكيد وبالتوفيق ان شاء الله offcinal_1_3am.xlsb

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

اولا: فى عدد 2 مستخدمين سوبر ادمن لا تنطبق عليهم صلاحيات واذونات المجموعات وهم s Deve والبيانات و كلمات السر لهم كما هى موضحة فى الكود ''--- ثوابت الدخول الخاصة Public Const cnstStrSuperUser As String = "s" Public Const cnstStrSuperPass As String = "s" Public Const cnstStrDevelopersUser As String = "Deva" Public Const cnstStrDevelopersPass As String = "d" طيب بما ان صاحب الافكار كل تفكيره كان ينحصر فى حصول الجميع على الافكار على طبق من ذهب لم يحاول اخفاء الاسم وكلمات مرور سوبر ادمن بكلمات مرور بطريقة مشفرة وكذلك لم يحاول اضافة طبقات تعمية مختلفة على الاكواد لان الهدف نشر العلم والمعرفة والافكار الالية ووجهة النظر كانت فى هذه النقطة كالاتى عدد 2 مستخدم سوبر ادمن لا تنطبق عليهم اى صلاحيات احدهم واضح وله بيانات داخل جدول المستخدمين المستخدم : Deve اما الاخر هو المستخدم : s والذى يعمل بدون وجود اى بيانات له داخل الجدول اى انه مستخدم شبح لا وجود له فى الجدول وغير مرئى ولا يمكن تعديل كلمة المرور له نعم من يريد اضافة التحقق من الصلاحيات لاى نموذج فقط يستطيع اضافة الحدث التالى فقط Private Sub Form_Open(Cancel As Integer) If Not funCheckPermissions(Me) Then Cancel = True End Sub أو كما فى التقرير Private Sub Report_Open(Cancel As Integer) If Not funCheckPermissions(Me) Then Cancel = True: Exit Sub End Sub طيب تم رفع المرفق كما هو حتى بالاكواد والافكار التى تم تعطيلها اثناء التطوير وبدون اضافة اكواد التحقق باستثناء النموذج : frmTestPer وكذلك التقرير : rptTest حتى انه تم استخدام كلمة Test للتأكيد على انها التى تخص التجربة ولذلك فقط تم وضح اكواد التحقق بداخلهم المرفق متاح للجميع مفتوح لمن يريد تعديل او تغيير اى شئ وفى توضيح كمان صغير مهم فى شاشة تسجيل الدخول لو لاحظت فى وضع التصميم توجد ازرار مخفية وهة المؤطرة باللون الاصفر تعمل فقط عندما تتم استخدام بيانات اى مستخدم سوبر ادمن بحيث تمكنه من فتح نماذج محددة دون فتح النظام بالكامل يستطيع مطور النظم تعديلها كما يحلو له تقدمت فى بداية كلامى ان العمل هدية وتم مشاركتها بعد اخذ الاذن من صاحب العمل ولكن تقريبا انا قمت بفحص العمل تقريبا بشكل شبه شامل من وجهة نظرى المتواضعة العمل يقترب فى الافكار والتطبيق من درجة الامتياز لانه يمكن مدير النظام من عمل الصلاحيات مرة واحدة لمجموعات العمل او حتى اضافة مجموعة واحدة فى المستقبل وتحديد الاذونات والصلاحيات المطلوبة لها ولكن بمجرد اضافة المستخدمين ايا كان العدد للمستخدمين لن يضطر لتحديد الاذونات والصلاحيات لكل مستخدم جديد فقط تحديد مجموعة العمل للمستخدم تنطبق عليها الاذونات والصلاحيات الخاصة بهذه المجموعة كما انه يمكن نقل المستخدم مستقبلا من مجموعة الى اخرى بسهولة وبذلك سوف ينطبق عليه صلاحيات واذونات المجموعة الجديدة فورا و فورا حتى لو كان المستخدم كان فى جلسة العمل نفسها التى كانت تعتمد الصلاحيات والاذونات للمجموعة القديمة حتى لو ينهى المستخدم جلسة العمل السابقة ويدء جلسة عمل جديدة لم اقم بتجربة هذه النقطة ولكن هذا ما بدا لى عندما قمت بتحيليل العمل ومن افضل ما اعجبنى فى العمل هو هذه الشاشة والأكثر من رائعة سهولة اختيار النماذج والتقارير وتوضيح كل منهم بنوعه من المراد تطبيق الصلاحيات عليها او التى لم يتم اختيارها لتطبيق الصلاحيات الفكرة والية العمل والمرونة بصراحة ممتازة جدا جدا جدا اجمل الامنيات بالاستمتاع بالتجربة

عملت بعض التعديلات خصوصاً للتقارير .. والبرنامج يعمل لديا بدليل الشرح التالي . وايضاً اليك المرفق بعد التعديل . SaadPermissionsLast-3.rar

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

بدل كلمة Undo ، اجعلها Exit Sub فقط .

وعليكم السلام Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer Dim sh As Object Dim folder As Object Dim FolderPath As String Dim FilePath As String stDocName = "tbl_Teacher_" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then ' اختيار مجلد Set sh = CreateObject("Shell.Application") Set folder = sh.BrowseForFolder(0, "اختر مجلد حفظ الملف", 0) ' لو إلغاء If folder Is Nothing Then Exit Sub FolderPath = folder.Items().Item().Path FilePath = FolderPath & "\" & stDocName & ".xls" ' 🔥 التحقق من وجود الملف If Dir(FilePath) <> "" Then If MsgBox("الملف موجود بالفعل:" & vbCrLf & FilePath & vbCrLf & vbCrLf & _ "هل تريد استبداله؟", _ vbYesNo + vbQuestion + vbMsgBoxRight, "تأكيد") = vbNo Then Exit Sub End If End If ' التصدير DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", FilePath, False MsgBox "تم حفظ الملف بنجاح في:" & vbCrLf & FilePath, vbInformation + vbMsgBoxRight, "تم" Else MsgBox "لا يوجد سجلات لتصديرها", vbExclamation + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

أنت هنا تريد أتمتة عمل مرتبط بعمل خارج نطاق التطبيق بمعنى أنت لاتعلم ماذا سيكون رقم الدفتر الجديد هل هو الرقم التالي أم رقم سابق كان قد تم السهو عنه من قبل امين الصندوق أو أو أو .... هذا يعني أن إحتمالات المتغيرات الخارجية ستكون كثيرة لذا فأفضل خيار لديك هو أن تجعل البرنامج يقوم بقراءة آخر إيصال والإحتفاظ بآخر رقمين منه ثم إضافتهما لرقم الإيصال الجديد وللحصول على النتيجة وفق طلبك هذا قمت بتعديل ملفك الأصلي للحصول على هذه النتيجة - عند إدخال رقم الإيصال سيقوم النموذج بالتعامل معه بناءاً على الرقم - إذا كان أقل من أو يساوي 1000 سيتم إرجاع رقم آخر إيصال تم إدخاله وإضافته للرقم الذي قمت بإدخاله (عندما يكون 1000 سيبدأ الدفتر التالي) - قد تضطر أحيانا لتصحيح رقم إيصال كنت قد أدخلته بالغلط عندها يمكنك إدخال الرقم كاملاً (5 أرقام أي أكبر من 1000) عندها سيتم الإحتفاظ بالرقم كما أدخلته - إذا صادف وتم بدء العمل بدفتر برقم سابق أو ليس الرقم الذي يلي الرقم الحالي عندها ستكون مضطر لإدخال الرقم كاملا (أو تصحيح الرقم) لأول إيصال فقط وبعدها سيتم التعامل مع هذا الرقم الجديد - جرب إجراء كل التعديلات التي يمكن أن تواجهها في العمل وتأكد من أن النتائج ستكون مطابقة للنتائج المرجوة منها أم لا Lab.accdb

كلام صحيح 100%

تمام فعلا لدي القاعدة الاصلية سؤالي هل يمكن اضافة هذه الاكواد للقاعدة الاصلية حاليا وجزاكم الله خيرا

الشرح غير موجود

اكيد هتعرف لما تتواصل معهم الالية

https://learn.microsoft.com/en-us/answers/questions/4884176/get-to-vba-code-in-access-split-database خدمة EverythingAccess.com: حسب البحث اعتقد انهم متخصصون في تحويل ACCDE إلى ACCDB كامل مع VBA ولكن سوف يطلبون إثبات الملكية

الاصدار الجديد نزولا على راى أخى : أحمد ساري استخدام عنوان الحقل للعرض وان لم يكن موجود يتم استخدام اسم الحقل UniversalSearch Pro v2.02.accdb.zip

كان الله في عونك اخي الكريم لا اعتقد هناك برامج 😭 ولكن انظر هذا الموقع ولم اجربهم شخصيا .... ولكن احذر من النصب وتأكد من مصداقيتهم في استرجاع الاكواد ... فرج الله همك EverythingAccess.com

اعرض الملف أداة إنشاء صيغة أوامر مربع الرسائل MsgBox القياسي {سلسلة الأدوات المساعدة المخصصة} أقدم لكم اليوم أداة بسيطة ولكن فائدتها كبيرة لما تختصره من الوقت والجهد في كتابة الأوامر الخاصة بمربعات حوار الرسائل MsgBox خصوصاً في حالة النصوص الطويلة بإستخدام هذه الأداة لن تحتاج إلا إلى إدخال عنوان الرسالة والنص الخاص بها وتحديد بقية الخيارات من خلال تحديدها من قائمة الخيارات بدون الحاجة إلى أي معرفة برمجية وعند الإنتهاء من تحديد الخيارات يمكنك إستعراض الرسالة للتأكد من ظهورها بالشكل المطلوب وعندها كل ماعليك هو نقر زر لنسخ صيغة الأمر والذهاب للمكان المطلوب في تطبيقك ولصقه بإمكان الأداة القيام بإنشاء صيغتين للأمر 1- صيغة الأمر البسيطة والتي ستكون بالشكل التالي MsgBox "نص الرسالة",vbOk,"العنوان" 2- صيغة الأمر ضمن شرط If وستظهر عندما تحتوي الرسالة على أكثر من زر لتصبح بالشكل التالي If MsgBox ("نص الرسالة",vbOkCancel,"العنوان")=vbOk Then End If كذلك ستجد خيارات إضافية كإمكانية تحديد إتجاه الرسالة لتناسب الرسائل باللغة العربية أو الإنجليزية وإمكانية الإحتفاظ بالنص في متغير والذي يكون مفيداً للغاية عند العمل مع النصوص الطويلة والتي تحتوي على أكثر من سطر وغيرها من المزايا الإضافية التي ستجدونها من خلال تجربتكم للأداة. كما ذكرت فالأداة بسيطة جداً لدرجة أني لم أحتاج لإضافة أي تعليمات توضيحية لطريقة عملها فهي لاتحتوي إلا على نموذج واحد فقط ويمكنك تخصيص قاعدة بيانات مستقلة للقيام بمساعدتك في إنشاء الصيغ لبقية التطبيقات أو إستيراد النموذج لأي تطبيق والعمل به بكل بساطة. كفائدة إضافية وحتى لا تحتاج لإستيراد النموذج إلى جميع تطبيقاتك فقد أنشأت منه نسخة تعمل كوظيفة إضافية Add-In مرفق معها مستند وورد يشرح طريقة تثبيتها وإستخدامها أرجو أن تنال هذا الأداة إعجابكم وإذا كانت هناك أي ملاحظات فأرجو ذكرها تحياتي صاحب الملف منتصر الانسي تمت الاضافه 03/26/26 الاقسام قسم الأكسيس  

بارك الله فيك استاذ

تفضل مع تعديل ملف الاكسل واضافة حقل تاريخ بداية الاجازة . اليك المرفق. ووافني بالرد . Bilal_Yamen-Last-1.rar

جزاك الله خيرا استاد منتصر الانسي هو المطلوب فعلا الف الف تحية

وعليكم السلام ورحمة الله وبركاته.. بدلاً من هذه اللفة الطويلة ، لم لا تذهب مباشرة لحذف كافة سجلات الجداول الموجودة في القاعدة التي اخترتها 😅

بعد إذن الآخ @kkhalifa1960 قمت بتعديل المثال ليقوم بتنفيذ الطلب ولكن لدي ملاحظة مهمة كل الحلول الواردة هنا تتعامل على أن العبارة المراد إجتزاؤها تتكون من كلمة واحدة بمعنى إذا كانت الدرجات مابين (الأولى والعاشرة) فهذه الحلول ستفي بالغرض ولكن لو كانت هناك درجات أعلى مثل (الحادية عشر أو السابعة عشر) فهذا يحتاج لمعالجة أخرى لهذا وجب التنويه تحياتي ahmad2026.rar

بسم الله الرّحمن الرّحمن الرحيم السلام عليكم ورحمة الله تعالى وبركاته إخوتي في الله؛ رُوّاد أوفيسنا المباركون؛ فيما يلي موقِعٌ هديّة خاصّة، لمن يعمل في مجال التّصميم والعروض التقديمية. موقع يحوي آلاف الرسومات الجاهزة مجانًا للموشن جرافيك والعروض التقديمية آلاف الرسومات الجاهزة مجانًا للموشن جرافيك لمشروعك القادم! رسومات توضيحية مجانية رائعة قابلة للتخصيص لمشروعاتك يُمكنك بتخصيص الرسوم التوضيحية وتحريكها وتنزيلها لإنشاء صفحات مخصصة، أو تطبيق أو عروض تقديمية رائعة! رابط الموقع https://storyset.com/ .......................... في أمان الله.

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

الخصائص ببساطة مجموعات المستخدمين — كل مستخدم ينتمي لمجموعة وكل مجموعة لها صلاحياتها التحكم في الصلاحيات للنماج والتقارير — وعددها 5 صلاحيات لكل كائن (فتح / إضافة / تعديل / حذف / تصدير) حماية النماذج والتقارير — لا يتم فتح أي نموذج أو تقرير إلا بعد التحقق من الصلاحية التصدير الآمن — تصدير التقارير والاستعلامات لـ PDF/Excel مع التحقق من الصلاحية أولاً الصلاحيات على مستوى المجموعة أى انه بنقل اى مستخدم من مجموعة لاخرى تنطبق عليه فورا صلاحيات المجموعة الرابط للمرفق تجدونه هنا وملاحطة هامة جدا جدا المشاركة مش من باب التحدى والمنافسة انا بدات الكلام ان المرفق هدية وتم اخذ الاذن من صاحبه بالنشر يغنى المشاركة من باب المشاركة فقط

الاخ tamerfayed يرجى تعديل الإسم للغة العربية طبقا لتعليمات المنتدى مشكلة COUNTIFS $C$8:$C$795,AF8,$B$8:$B$795,$T$9 تعديل مدى البحث c / b من 795 إلى 1000 $C$8:$C$1000,AF8,$B$8:$B$1000,$T$9 OK Otlob Sheet -Feb ,2026.xlsx

اولا / الملف السابق به كودين كلاهما معاينة تم تعديل احدهما الى طباعة ثانيا :- للتطبيق على ملفك / احعل لغة الجهاز العربية وانسخ الكود المرفق وفي ملفك الاخر قم بالدخول إلى صفحة الفيجوال بيسك عن طريق التبويب Developer(المطور) ثم Visual Basic ثم من قائمة Insert اختر Module والصقه به واربطه بزر في الصفحة المراد ترقيمها ملاحطة/ الكود المرفق مهمته الطباعة مع الترقيم ان اردت المعاينة مع الترقيم بدون طباعة غير كلمة FALSE الى TRUE في الجملة ws.PrintOut From:=i, To:=i, Preview:=False Sub طباعة() Dim ws As Worksheet Dim totalPages As Long Dim i As Long Dim pageNum As Integer Set ws = ActiveSheet totalPages = (ws.HPageBreaks.Count + 1) * (ws.VPageBreaks.Count + 1) For i = 1 To totalPages pageNum = Application.WorksheetFunction.RoundUp(i / 2, 0) If i Mod 2 <> 0 Then ws.PageSetup.CenterFooter = "الصفحة " & Format(pageNum, "00") Else ws.PageSetup.CenterFooter = "تابع الصفحة " & Format(pageNum, "00") End If ws.PrintOut From:=i, To:=i, Preview:=False Next i End Sub

يسرني ويسعدني أن أضع بين يديكم برنامج التدريب الالكتروني قمت بتصميمه من الصفر أخذ مني جهد ووقت كبير . استفدت من خبراء هذا المنتدى المبارك. لي طلب أن تدعو لوالدي وجميع مرضى المسلمين والمسلمات بالشفاء العاجل. هذا المشروع أضعه صدقة جارية لكل طالب علم ، و كل مشارك في هذا المنتدى . أسأل الله أن يتقبل منا ومنكم صالح الأعمال . ولا تنسونا من دعواتكم الصادقة في ظهر الغيب . اترك البرنامج لكم لتكتشفوا أسراره 😄 اضف مرفقات موجوده ProTraining20.zip

وعليكم السلام -لا يمكنك هذا الا من خلال هذا الموقع الطباعة بدون فتح ملف (طباعة مباشرة)

أخي الكريم مهند بالنسبة لموضوع الفورمات فأمره صعب ومعقد وعواقبه غير مضمونة .. نخشى أن يقوم أحدهم بتجربة الكود فينتهي كل شيء بالنسبة له ههههههه إليك حل آخر وهو حذف كل الملفات والمجلدات والمجلدات الفرعية في مسار محدد (قمت بالتجربة على فلاشة عليها ملفات غير هامة) Sub Clear_All_Files_And_SubFolders_In_Folder() Dim FSO As Object Dim MyPath As String Set FSO = CreateObject("Scripting.FileSystemObject") MyPath = "I:\" If Right(MyPath, 1) = "\" Then MyPath = Left(MyPath, Len(MyPath) - 1) End If If FSO.FolderExists(MyPath) = False Then MsgBox MyPath & " Doesn't Exist", 64 Exit Sub End If On Error Resume Next FSO.DeleteFile MyPath & "\*.*", True FSO.DeleteFolder MyPath & "\*.*", True On Error GoTo 0 End Sub غير المسار I الموجود في الكود إلى المسار الذي ترغب في حذف الملفات والمجلدات به ، وأعلمنا بالنتيجة تقبل تحياتي

اخوانى السلام عليكم الدالة ReverseCell احدى الدوال المدمجة فى الأفيس تؤدى هذا الغرض موجودة فى أوفيس 2010 فما فوق ولا أدرى أن كانت فى 2007 أو 2003 الكود الذى قدمه أخى علاء يعمل وهو لنفس الدالة ReverseCell ويعتبر هنا دالة من النوع UDF يستعملها اللى ما عندوش الدالة المدمجة كأصحاب أوفيس 2003 مثلا سؤال لأخى أحمد أبوزيزو : ازاى حولت ملف الــ PDF الى اكسل أبحث عن طريقة بكود وليس عن طريق منتديات التحويل أو البرامج ؟ ملحوظة صغيرة أرجو أن تتقبلوها بصدر رحب : كلمة محتوايات خطأ والصواب محتويات وأطلب من الإدارة المراجعة والتصحيح . هذا المرفق التالى تطبيق للدالة عكس محتويات الخليه.rar

من واجبنا الالتزام بالتعليمات واحترام لمن قدم لنا العلم و الفكره والنصح والمشوره اذكرك واذكر نفسي بقوله تعالى: { هل جزاء الإحسان إلا الإحسان} جزاك الله الف خير