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

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

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

لا اعرف عمن تتحدث انت يبدو انك تخلط بينى وبين شخص اخر مع الاسف

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

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

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

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

ههههههه صعبتها علي يا رجل على سبيل الدعابة فقط .

تفضل استاذ @dd13901390 طالع الشرح جيداً واليك المرفق . ووافني بالرد . DD13901390.rar

طب ما تعرفنا بحضرتك

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

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

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

يفتح كـــ accdb واعتقد 95% من ادواتك موجودة ولكن صامت ..

كان الله في عونك سبق وان حصل معي مثل ذلك .. انا لم افقد الهاردسك بل الملف بحثت كثيرا في جميع الاقراص القديمة والجديدة ولكني لم اجده فاستخلفت الله في ذلك وبدأت العمل منجديد وبعد 5 سنوات ظهر لي بالصدفة وانا اقلب في المجلدات من ضمن محفوظاتي ولكن باسم مختلف كنت حينها ابحث باسم الملف التنفيذي اما سؤالك اخونا خليفة .. فكان عندي هذا البرنامج نسخة قديمة فقط mdb وكان يسترجع كل شيء الا الكود علما انه يحذف اسم المصدر من الحقول برنامجك كما هو ولكن بدون مكينة

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

حلوة الفكرة احييك اخى ابشر

بعد اذن استاذ @Foksh تفضل استاذ @dd13901390 الملف بعد التعديل واضافة نموذج لادخال جديد . ووافني بالرد . الاختبار2-1.rar

هذا البرنامج يعيد كل شئ ماعدا الاكواد وهو مدفوع AccessFIX وهو لديا الى 13/4/2026 لو حابب ارسله لي وانا حاضر

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

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

عفوا استاذنا ملاحظتي غير دقيقة .. وعمل رائع زادك الله علما ورفعة

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

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

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

أخى أبو زهرة جرب هذا الكود Sub ChangingPaperSize() Application.ScreenUpdating = False Dim Cl As Range blnAns = Application.InputBox("أدخل 3 للطباعة على ورق 3" & vbCr & "أدخل 4 للطباعة على ورق 4", "اختر نوع ورق الطباعة", , , , , , 4) If blnAns = 3 Then For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA3 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False Else For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA4 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False End If Rows("11:36").Select Selection.EntireRow.Hidden = False Range("A1").Select Application.ScreenUpdating = True End Sub

اخى الكريم يمكنك استخدام هذه المعادله =INDEX($A$2:$D$5;MATCH($D8;$D$2:$D$5;0);COLUMN(A:A)) او =SUMPRODUCT(($D$2:$D$5=$D$8)*($A$2:$A$5)) او {=VLOOKUP($D8;IF(($D$2:$D$5=$D$8)*($A$2:$A$5);$D$2:$D$5;"");1;0)}

استاذى الفاضل مش عاوز اى ترقيم انا بكتب رقم الابصال 55426 وكل الايصالات التى تاتى بعد هذا الرقم بيكون فيها اخر رقمبن 55 ثابيتن عاوز بدل مااكتب خمسة ارقام اكتب 3 ويكون الرقمن الاخرين ثابتين انظر حقل NEW قى القاعدة الجديدة المرسلة الموضوع لا علاقة لة بالترقيم تسهيل الغمل بدل كتابة رقم الايصال بالكامل خمسة ارقام نختصرة الى ثلاثة ارقام متغييرين ثابتين 362 55 lab2.accdb