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

Try the file كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار.xlsm

في هذه المشاركة سأحاول أن اشارك حضراتكم بعض المحاضرات و الدروس التي يلقيها خبراء عالميين في مجال الاكسيس المحاضرة الاولي : Access Add-in Helper with Geoffrey L. Griffith

لفصل الحروف والارقام داخل الاستعلام انت بحاجة الى دالة مثل هذه 'فصل الحروف Public Function textNum(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then Else lets3 = lets3 & lets End If Next textNum = lets3 End Function 'فصل الارقام Public Function Numtext(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then lets2 = lets2 & lets End If Next Numtext = lets2 End Function ولإنشاء جدول جديد يمكنك استخدام الاستعلام نفسه انظر المرفق فصل الحروف عن الارقام دالة2 .rar

المحاضرة الثانية: Get and Post with JSON using Microsoft Access and VBA

وهذه طريقتي .. في محاولة لقبض العصى من المنتصف أيضا 😇🌼 بكود من سطر واحد .. واستخدام التنسيق الشرطي .. BlockExam_Moosak.accdb

من الواضح أن الأخ @figo82eg يبحث عن الجماليات ليظهر علامتي الصح والخطأ بشكل والوان مميزة ولكني أضم صوتي لصوت الأخ @AbuuAhmed في أن إستخدام حقل نعم/لا هو السبيل الأفضل والأسهل ولكن بمراجغة الحل الذي طبقه فيه مشكلة لأن مربع التحديد غير مرتبط بحقل في الجدول لذلك إذا قمت مثلا بتحديد السجل الأول وإنتقلت للسجل الثاني سيظل التحديد True رغم أن قيمة الحقل المفترض أنها False لذا مسكت العصا من المنتصف وقمت بتعديل المثال ليحقق الأمرين تحياتي BlockExam_03.rar

أيضاً كإضافة عن الإستعلام السابق .. جرب هذا الإستعلام أيضاً لإنشاء جدول جديد ، واضافة القيم فيه بعد فصلها .. SELECT maal, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)), Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)) ) AS الرقم, IIF(IsNumeric(Left(Trim(maal), 1)) = True, Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)), Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)) ) AS الاسم INTO TAGE_F FROM TAGE WHERE maal Is Not Null;

وهاتان دالتان كتبتهم من زمان 🙂🌷 : *دالة تفصل الأرقام عن الحروف ودالة تفصل الحروف عن الأرقام* *شرح الكود:* الدالة تستخرج الأرقام من جمله تحتوي على أرقام وحروف .. مثال1 : " أسماء الله 99 أسما " - النتيجة: 99 مثال2 : " أسماء الله 99 أسما " - النتيجة: أسماء الله أسما *الكود:* '==========================================(لاستخراج الأرقام فقط من النص) Public Function ExtractNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If IsNumeric(L) Then r = r & L End If Next x ExtractNumbersFromText = Trim(r) End Function '==========================================(ولإزالة الأرقام من النص والإبقاء على الحروف فقط) Public Function RemoveNumbersFromText(strText As String) Dim x As Long Dim L As String Dim r As String For x = 1 To Len(strText) L = Mid(strText, x, 1) If Not IsNumeric(L) Then r = r & L End If Next x RemoveNumbersFromText = Trim(r) End Function *طريقة الاستدعاء (الاستخدام):* ExtractNumbersFromText("Your text with 123456 Here") RemoveNumbersFromText("Your text with 123456 Here") *مكتبة الأكواد*

الحمد لله توصلت لبعض الاكواد الرائعة ولتعميم الافادة إليكم الملف وبه 7 اكواد للنسخ وللنقل ومع الحفاظ على التنسيق وبدونه وايضا اضافة شرط رابع مع الحفاظ على ما تم نقله Book1 (1).rar

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

و عليكم السلام جرب الملف الرقم السري 1234 كود إخفاء واظهار شيتات محددة برقم سري والباقي ظهار 2.xlsm

تفضل الملف و جرب كتابة اسماء بها عبد في العمود الثالث و طبق عليها ما تريد حذف المسافات(1).xlsm

منقول: أوقف حاكم 100 سجين في دائرة وأرقامهم من 1 إلى 100 أعطى الأول سيفا فقتل رقم 2 ثم أخذ رقم 3 السيف وقتل رقم 4 . . أخذ رقم 99 السيف وقتل رقم 100 أخذ رقم 1 السيف وقتل رقم 3 استمرت لعبة الموت حتى بقي واحد فقط. ما رقم الذي تبقى؟ محاولاتكم يجب أن تكون برمحيا وليست رياضياتيا، فرياضياتيا لها معادلة أو قانون مسمى. لكم مطلق الحرية باستخدام الأكواد أو الجداول والاستعلامات أو بهما معا أو بأي مكون من مكونات الأكسس. الحصول على الإجابة الصحيحة بحد ذاته تميز ولكن لو تم بواسطة الشفرة/الكود فقط يكون أكثر تميزا وله الأفضلية. وبالطبع كلما أختصرت المحاولة كلما كانت أفضل ولكن ليكن تركيزكم أولا على الحصول على النتيجة. لك مبرمج محاولتين ولا يسمح برقع محاولة ثالثة. لا تلجأوا إلى الذكاء الاصطناعي. حل هذا المثال هو 73، حتى تستطيعوا مراجعة نتائجكم. نريد نتائج للعدد: 10 و 500 و 7000 للمشرفين: أي كلمة في المشاركة محظورة يمكنكم تبديلها بأخرى بنفس المعنى.

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

أستاذ يمكن الوصول للحل بدون معرفة عدد الدورات.

بارك الله فيك أستاذ أحمد . كما تفضلت حضرتك بالملف فإن معادلة العلامة خبور رائعة و تصلح لهذا الملف تماما فقط قم بنسخ الكود التالي في موديل جديد في في محرر الأكواد Function kh_Names(FullName As String, ParamArray iNdex1()) As String Dim i As Integer Dim kh_Split, MyArray, Ar Dim Kh_String As String, Sn As String, Re As String On Error GoTo Err_Kh_Names '====================================== MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _ , " الله", " الدين", " الإسلام", " الاسلام", " الحق") '====================================== Sn = Application.WorksheetFunction.Trim(FullName) For Each Ar In MyArray Re = Replace(Ar, " ", "^") Sn = Replace(Sn, Ar, Re) Next '====================================== kh_Split = Split(Sn, " ", , vbTextCompare) On Error Resume Next For i = 0 To UBound(iNdex1) Kh_String = Kh_String & " " & kh_Split(iNdex1(i) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") kh_Names = Kh_String Exit Function Err_Kh_Names: kh_Names = "" End Function ثم ضع المعادلة التالية في خانة اسم الأب مثلا: =kh_Names(H9;2;3;4;5) مع مراعاة الفاصلة عادية أو منقوطة حسب اصدار الاوفيس مجمع 2026بعد نتيجة ثالثة.xlsm

وعليكم السلام ورحمه الله وبركاته راجع الملف لعله المطلوب

وعليكم السلام ورحمة الله وبركاته .. هل هذا هو المطلوب فعلاً ؟؟ فقط هذا الكود في حدث بعد التحديث للشيك بوكس :- Private Sub CHK_AfterUpdate() Dim GradeValue As String If Me.CHK = -1 Then Select Case Me.نص74 Case "أولى" GradeValue = "1" Case "ثانية" GradeValue = "2" Case "ثالثة" GradeValue = "3" Case "رابعة" GradeValue = "4" Case "خامسة" GradeValue = "5" Case "سادسة" GradeValue = "6" Case Else GradeValue = Null End Select Me.نص76 = GradeValue Else Me.نص76 = Null End If End Sub sssssssss.zip

هذا لأنك تقوم بتحديد السجلات في النموذج ثم تقوم بإغلاقه لتذهب لتشغيل الاستعلام والمشكلة أن حدث الإغلاق للنموذج يقوم بإلغاء كل التحديدات ولكن إذا قمت بشغيل الاستعلام من داخل النموذج سيقوم بالترحيل بشكل طبيعي اليك المثال معدل تحياتي za-Test1 (1).rar

مشاركة مع معلمي الفاضل .. جرب هذا الاستعلام وشوف النتيجة SELECT maal, Trim(Left(Trim(maal), InStr(Trim(maal) & " ", " ") - 1)) AS الرقم, Trim(Mid(Trim(maal), InStr(Trim(maal), " ") + 1)) AS الاسم FROM TAGE;

محاولتي قمت بتبديل المرفق بعد أن تبين لي أني فهمتك خطأ الحل الآن به طريقتين على مستوى الصناديق أو على مستوى السجل. BlockExam_02.accdb

بالإستفادة بالأداة الرائعة للأخ @Foksh الموجودة في موضوع مستورد السجلات الذكي قمت بتعديل الملف ليتم العمل عبر هذه الأداة يرجى تجربة التعديل تحياتي تحديد البرنامج1.rar

وعليكم السلام ورحمة الله وبركاته .. اذهب الى تبويب تصميم التقرير = Report Design انقر على ايقونة مجموعة و فرز ( على ما أعتقد باللغة العربية ) = Group & Sort في الشاشة ستلاحظ فتح شاشة اسفل التقرير ، انقر على اسم الحقل واحذفه من اشارة X

السلام عليكم ورحمة الله وبركاته اولا اود ان اشكر الاساتذة الافاضل الذين طالما لم يبخلوا علي بمساعدة وجل ما تعلمته ووضعته في هذا البرنامج اما بمساعدتهم المباشرة او بما قدموه من اعمال برنامج البسيط لشئون الطلاب ( مجاني تماما) يصلح للمدارس من رياض الاطفال والابتدائي والاعدادي بيانات التلاميذ متضمنة استخراج النوع وتاريخ الميلاد والسن في اول اكتوبر والمحافظة من الرقم القومي واستخراج البريد الموحد وكلمة المرور من الكود والرقم القومي للصفوف من الرابع للثالث الاعدادي سجل القيد قوائم 40 تلميذ قوائم 60 تلميذ قوائم 80 تلميذ سجل التقييمات للصفوف الاولى ورياض الاطفال سجل التقييمات للصفوف العليا والاعدادي سجل الغياب مع امكانية تصدير ملف الغياب كاكسيل سواء قبل ملء الغياب او بعده سجل النشاط الرياضي سجل المصروفات بنوعين 1 -يستخرج المسدد وغير المسدد 2 - انواع السداد سواء كامل او ضمان او ابناء عاملين سجلات 100 مليون صحة سجل للكتب للصفوف الاولى / الصفوف العليا / الاعدادي الاحصاء العامة للمدرسة احصاء للفصول احصاء المصروفات ( مسدد / غير مسدد / ضمان / ابناء عاملين / ايتام) سجلات قابلة لتعديل البيانات العناوين مثل التقييمات والصحة والرياضي حذف جميع البيانات بضغطة زر ترحيل التلاميذ للصفوف الاعلى امكانية النسخ من ملف قديم يبدا من الاصدار الرابع ليتم بصورة سليمة ارجو ان يحقق الفائدة للجميع رابط البرنامج https://top4top.io/downloadf-2780bcqwh1-rar.html رابط اخر https://www.mediafire.com/file/y503r9sdhbcroxz البسيط اعدادي.xlsb البسيط تعليم اساسي.xlsb البسيط لشئون ابتدائي ورياض.xlsb الجديد في هذا الاصدا ر بتاريخ15/8/2025 تعديل ترحيل التلاميذ بحيث الباقي والمنقطع لا يتم ترحيله ويبقى في صفه تجده باخر الصف تعديل احصاء الفصول بحيث يتم استدعاء الفصول الفعلية فقط عدم التقيد بعدد معين للفصول حتى اكثر من50 فصل تعديل فورم البحث بجزء من الاسم اضافة صفحة الباقون ويتم تعبئتها تلقائيا بعد الترحيل البسيط لشئون الطلبة 21-8-2024.zip

يمكنك مشاهدة الفيدو من هنا لطريقة عمل الملف

تفضل تم التحسين على الملف بخصوص المشكلة الاولى المشكلة الثانية تم فصل الصفحات تكون كل صفحة 66 صف واضفت لك للتوضيح بداية كل صفحة يكون لون الخط في الصف بالاحمر عشان تنسق الصفحات إذا صار فيه لخبطة عندك والكود محسن ينفذ لك الامر خلال اقل من 8 ثواني Book1.rar

جرب هذا الملف بعد التعديل . حيث تم تعديل الكود ليصبح :- Option Explicit #If VBA7 Then Private Declare PtrSafe Function OpenProcessToken Lib "advapi32.dll" ( _ ByVal ProcessHandle As LongPtr, _ ByVal DesiredAccess As Long, _ ByRef TokenHandle As LongPtr _ ) As Long Private Declare PtrSafe Function GetTokenInformation Lib "advapi32.dll" ( _ ByVal TokenHandle As LongPtr, _ ByVal TokenInformationClass As Long, _ ByRef TokenInformation As Any, _ ByVal TokenInformationLength As Long, _ ByRef ReturnLength As Long _ ) As Long Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As LongPtr, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long _ ) As LongPtr #Else Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _ ByVal ProcessHandle As Long, _ ByVal DesiredAccess As Long, _ ByRef TokenHandle As Long _ ) As Long Private Declare Function GetTokenInformation Lib "advapi32.dll" ( _ ByVal TokenHandle As Long, _ ByVal TokenInformationClass As Long, _ ByRef TokenInformation As Any, _ ByVal TokenInformationLength As Long, _ ByRef ReturnLength As Long _ ) As Long Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long _ ) As Long #End If Public Function IsRunAsAdmin() As Boolean Const TOKEN_QUERY As Long = &H8 Const TokenElevation As Long = 20 Dim hToken As LongPtr Dim elev As Long Dim retLen As Long If OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken) <> 0 Then If GetTokenInformation(hToken, TokenElevation, elev, LenB(elev), retLen) <> 0 Then IsRunAsAdmin = (elev <> 0) End If End If End Function Public Sub RestartAsAdmin() Dim exePath As String Dim wbPath As String exePath = Application.Path & "\EXCEL.EXE" wbPath = """" & ThisWorkbook.FullName & """" ShellExecute 0, "runas", exePath, wbPath, vbNullString, 1 Application.Quit End Sub Public Sub CreateTextFile() Dim FilePath As String Dim FileNum As Integer If Not IsRunAsAdmin Then MsgBox ". (Administrator) البرنامج بحاجة إلى صلاحيات مسؤول" & vbCrLf & _ "... لطلب صلاحيات المسؤول Excel سيتم اعادة تشغيل", _ vbExclamation + vbMsgBoxRight, "تحتاج صلاحيات" RestartAsAdmin Exit Sub End If FilePath = "C:\Windows\fs.txt" FileNum = FreeFile Open FilePath For Output As #FileNum Print #FileNum, "https://www.officena.net/" Close #FileNum MsgBox "تم إنشاء الملف بنجاح في:" & vbCrLf & FilePath, _ vbInformation + vbMsgBoxRight, "نجاح" End Sub Book1.zip

بارك الله فيك أستاذ وجزاك الله خيرا

الجديد في هذا الاصدا ر بتاريخ15/8/2025 تعديل ترحيل التلاميذ بحيث الباقي والمنقطع لا يتم ترحيله ويبقى في صفه تجده باخر الصف تعديل احصاء الفصول بحيث يتم استدعاء الفصول الفعلية فقط عدم التقيد بعدد معين للفصول حتى اكثر من50 فصل تعديل فورم البحث بجزء من الاسم اضافة صفحة الباقون ويتم تعبئتها تلقائيا بعد الترحيل التحميل من هنا

الاجابة في المشاركة التالية

تمام كان الخطأ في كود اسم الورقة المفروض يكون www

جرب الملف التالي مع أن حجم البيانات هائل و يستغرق وقت طويل و يستهلك رامات الكمبيوتر 512 صفحة و كل صفحة بها 3 كشوف. الكود يقوم بتصدير الكشوف إلى مجلد على شكل ملفات بي دي اف كل ملف به 3 كشوف و كذلك إنشاء ورقة عمل بالتقسيمات Book2.xlsm

السلام عليكم ورحمة الله أشارك معكم اليوم أكواد داخل وحدة نمطية عامة تم تطويرها لتصفية محتويات أي مربع سرد (ComboBox) في أي نموذج بشكل ديناميكي بمجرد الكتابة داخل مربع التحرير والسرد تصفية ديناميكية: يدعم التصفية المتعددة باستخدام أكثر من حقل (مثل الاسم + الرقم القومي) تدعم التصفية على حقل واحد أو حقول متعددة باستخدام نمط LIKE '*...*' وذلك لتتم التصفية بناء على اى جزء من الكلمة الكود داخل الوحده النمطية العامة Option Compare Database Option Explicit Private dictRowSources As Object Private strLastFilterValue As String Private strLastComboName As String Private Sub EnsureDictionary() If dictRowSources Is Nothing Then Set dictRowSources = CreateObject("Scripting.Dictionary") End If End Sub Public Sub ClearComboMemory(ByVal frm As Access.Form) Dim strKey As Variant Call EnsureDictionary For Each strKey In dictRowSources.Keys If Left(strKey, Len(frm.Name) + 1) = frm.Name & "." Then dictRowSources.Remove strKey End If Next End Sub Public Sub FilterCombo(ByVal frm As Access.Form, _ ByVal strComboName As String, _ Optional ByVal strFilterField As String = "") Dim cmb As Access.ComboBox Dim strSourceSQL As String Dim strFilterValue As String Dim strFilteredSQL As String Dim strOrderByClause As String Dim strKey As String Dim objRegex As Object Dim objMatches As Object Dim arrFilterFields As Variant Dim strWhereClause As String Dim i As Long On Error GoTo ExitWithError ' التحقق من صحة النموذج وعنصر التحكم If frm Is Nothing Then MsgBox "النموذج غير صالح.", vbExclamation Exit Sub End If ' Debug.Print "Form: " & frm.Name ' Debug.Print "ComboBox: " & strComboName Set cmb = frm.Controls(strComboName) ' التحقق من مصدر البيانات Call EnsureDictionary strKey = frm.Name & "." & cmb.Name If dictRowSources.Exists(strKey) Then strSourceSQL = dictRowSources(strKey) Else strSourceSQL = Trim(Replace(cmb.RowSource & "", ";", "")) ' إزالة الفاصلة المنقوطة ' Debug.Print "RowSource: " & strSourceSQL If Len(strSourceSQL) = 0 Then MsgBox "مصدر البيانات غير صالح.", vbExclamation Exit Sub End If dictRowSources.Add strKey, strSourceSQL End If ' إعادة تعيين المصدر إذا لم يتم توفير حقل تصفية If Len(strFilterField) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق من نوع عنصر التحكم النشط If TypeOf Screen.ActiveControl Is Access.TextBox Or TypeOf Screen.ActiveControl Is Access.ComboBox Then strFilterValue = Nz(Screen.ActiveControl.Text, vbNullString) ' Debug.Print "ActiveControl: " & Screen.ActiveControl.Name ' Debug.Print "FilterValue: " & strFilterValue Else ' Debug.Print "ActiveControl is not TextBox or ComboBox" If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' إعادة تعيين المصدر إذا كانت القيمة المصفاة فارغة If Len(strFilterValue) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق مما إذا كانت القيمة المصفاة أو ComboBox قد تغيرت If strFilterValue = strLastFilterValue And strComboName = strLastComboName Then cmb.Requery cmb.Dropdown Exit Sub End If ' استخدام Regex لاستخراج ORDER BY Set objRegex = CreateObject("VBScript.RegExp") With objRegex .Global = True .IgnoreCase = True .Pattern = "\s*ORDER\s+BY\s+.*$" End With Set objMatches = objRegex.Execute(strSourceSQL) If objMatches.Count > 0 Then strOrderByClause = objMatches(0).Value strSourceSQL = Trim(Replace(strSourceSQL, strOrderByClause, "")) Else strOrderByClause = "" End If ' Debug.Print "SourceSQL: " & strSourceSQL ' Debug.Print "OrderBy: " & strOrderByClause ' التحقق من الحقول وإنشاء شرط WHERE لحقول متعددة If Len(strFilterField) > 0 Then arrFilterFields = Split(strFilterField, ",") strWhereClause = "" For i = LBound(arrFilterFields) To UBound(arrFilterFields) Dim strField As String strField = Trim(arrFilterFields(i)) If Len(strField) > 0 Then If Len(strWhereClause) > 0 Then strWhereClause = strWhereClause & " OR " strWhereClause = strWhereClause & strField & " LIKE '*" & Replace(strFilterValue, "'", "''") & "*'" End If Next i If Len(strWhereClause) = 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField, vbExclamation Exit Sub End If On Error Resume Next strFilteredSQL = strSourceSQL & " WHERE (" & strWhereClause & ")" & strOrderByClause ' Debug.Print "FilteredSQL: " & strFilteredSQL cmb.RowSource = strFilteredSQL If Err.Number <> 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField & vbCrLf & "Error: " & Err.Description, vbExclamation On Error GoTo ExitWithError Exit Sub End If On Error GoTo ExitWithError Else strFilteredSQL = strSourceSQL & strOrderByClause cmb.RowSource = strFilteredSQL End If ' تعيين المصدر المصفى وتحديث واجهة المستخدم cmb.Requery cmb.Dropdown strLastFilterValue = strFilterValue strLastComboName = strComboName Exit Sub ExitWithError: Select Case Err.Number Case 2118 Resume Next Case Else MsgBox "حدث خطأ أثناء التصفية: " & Err.Number & " | " & Err.Description, vbExclamation End Select End Sub الاستدعاء فى النموذج في حدث Click : لإعادة تحميل القائمة الأصلية لمربع السرد عند الضغط عليه ' في حدث Click Private Sub ComboBoxName_Click() FilterCombo Me, "ComboBoxName" End Sub وايضا في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب حقل واحد ' في حدث KeyUp Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName" End Sub مع امكانية في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب أكثر من حقل ' في حدث KeyUp لعمل التصفية المتعددة Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName, FieldName2" End Sub تحياتى Filter inside the Combobox.accdb

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

اخي الكريم السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير هل يراودك شك احيانا في بعض الكلمات او الرموز عند تسمية الحقول هل هي محجوزة أم لا ؟ اليك الحل هدية العيد : في المرفقات تطبيق بحثي يشتمل على جميع كلمات ورموز الاكسس المحجوزة والتي يجب أخذ الحيطة عند تسمة الحقول واجتناب التسمية بها لان ذلك يؤدي الى ظهور أخطاء أمام المبرمج يخفى عليه سببها . آمل ان تجدوا الفائدة ،،، dbx.rar نسخة محدثة بتاريخ 15/08/2025 Reserved words in Access.rar

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

اعرض الملف شيت رواتب الموظفين شامل شيت رواتب الموظفين يشمل الرواتب بالتفصيل والحضور والانصراف نهاية الخدمة والسلف وانتهاء الاقامة صاحب الملف asembero تمت الاضافه 07/18/25 الاقسام قسم الإكسيل  

الموضوع قديم يعود لــــ 2011 وقد عرض اخوي الاستاذ فادي الرابط بالامس في احدى مشاركاته .. وحين دخلت الموضوع .. ونزلت المرفق وجدت فيه مشكلة عند الفتح لذا قمت بتجديد المرفق Reserved words in Access.rar

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