طير البحر

الاخ المحترم @Foksh قمت بتعديل نهائي لما يلزم مع الاستفادة من خيار اعادة التشغيل المقدم من طرفكم وضبط كل شئ دون التأثير على الخيارات او اجراء تغييرات غير محسوبة كما تم اضافة زر اعادة تشغيل كخيار للشريط العائم ونموذج الارضية والنموذج الرئيسي ارجو ان ينال الامر اعجابك وكنت اتمنى استبدال الملف الرئيسي باول البوست dboptions.rar

اعاني من ظهور ال Backstage الخاص باكسس اما مع فتح قاعدة البيانات فتظهر ال Backstage فى نافذه جديده او بعد اغلاقها تظهر ال Backstage ايضا فى نافذه جديده راسلت مجتمع مايكروسوفت وهذه المناقشة معهم ولثاني مرة يحيلوني الى فريق المطورين ارجو الاطلاع لعل المشكلة واجهت احدكم واستطاع حلها https://answers.microsoft.com/en-us/msoffice/forum/all/اعاني-من/af241c23-7169-4875-bac8-edf57e7b2b33

من الجبد ولاثراء تامعرفة ان نعمل معا اشكر مجهودك

اعتذر عن الخطأ فهو خاص بكود اخر غير مضمن وسارفع نسخة جديدة قريبا بدون الخطأ وتتضمن اقتراحكم باعادة التشغيل الاخ @Foksh مرفق نسخة معدلة لكن ارجو ضبط موضوع اعادة التشغيلواعادة الارسال dboptions.rar

على قددر علمي اقدم لكم هذه الهدية للتحكم فى خيارات العرض والتشغيل كما هو موضح فى الصورة المرفقة اضفت نموذج ارضية وشريط ادوات عائم يمكنتك تطويره يلاحظ ان خاصية autocompact معطلة فى كلا الحالتين يمكنك تفعيلها تقبلوها منى خالصة لوجه الله تعالى وارجوا امدادى بخصائص اخرى حبث انى حديث عهد باكسس ولا تنسوا التقييم والرأي ولفت نظرى لاى خطأ كلمة السر 123 يمكنك تعديلها dboptions.rar

cleantabeles.rar تفضل اخي كان هناك خطأين اعتذر عنهم لاني جمعت لك الكود بسرعة وكنت اختبر من زر وليس موديول فقط تستبدل me باسم النموذج هكذا forms!cleaner كما ان هناك متغير معلن اكثر من مرة اوقفته الان الكود يعمل لكننا استبدلنا احد الحروف الخمسة بكلمة عبد لامكانك اضافة حلقة جديدة للحرف او اى شئ اخر cleantabeles.rar

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

تسلم

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

بمجرد نقلي قاعدة اكسس من جهازي الشخصي الى جهاز المكتب ظهرت العديد من الاخطاء تم تجاوز بعض الاوامر فى الوظيفة المعينة لملف autoexec ظهرت مشاكل فى اكواد الاضافة التى بها date , now ولم افحص باقى العمل الجهازين متطابقين من حيث الهارد وير تنسيق التاريخ والوقت مختلف ارجو ارشادنا بنصائح عند نقل القاعدة لجهاز العميل او جهاز اخر وماهى الاعدادات التى يمكن ان تؤثر على الاداء مشكورين مقدما

Option Compare Database Option Explicit ' ÎÇÕ ÈÇáÊÍßã Ýì ÙåæÑ æÇÎÝÇÁ ÇÒÑÇ ÇáÊßÈíÑ æÇáÊÕÛíÑ æÇáÇÛáÇÞ ÇßÓÓ Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long) As Long Private Const WS_MINIMIZEBOX = &H20000 Private Const WS_MAXIMIZEBOX = &H10000 Private Const WS_CLOSEBOX = &H80000 Private Const GWL_STYLE = (-16) ' ÎÇÕ ÈÇáÛÇÁ æÙíÝÉ ÒÑ ÇÛáÇÞ ÇßÓÓ Public Const SC_CLOSE = &HF060 Public Const MF_BYCOMMAND = &H0 Public Declare PtrSafe Function GetSystemMenu Lib "user32" _ (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare PtrSafe Function DeleteMenu Lib "user32" _ (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) Sub DisableMinimizeButton() Dim hwnd As Long Dim M As Long hwnd = Application.hWndAccessApp M = GetWindowLong(hwnd, GWL_STYLE) M = M And Not WS_MINIMIZEBOX Call SetWindowLong(hwnd, GWL_STYLE, M) End Sub Sub RestoreMinimizeButton() Dim hwnd As Long Dim M As Long hwnd = Application.hWndAccessApp M = GetWindowLong(hwnd, GWL_STYLE) M = M Or WS_MINIMIZEBOX Call SetWindowLong(hwnd, GWL_STYLE, M) End Sub '---------------------------------------------------------------------------------------- ' الكود الخاص بالغاء وظيفة زر اغلاق اكسس واستعادته ضعه فى حدث فتح النموذج الرئيسي او حيثما شئت Sub DisableCloseButtonfunction() Dim hwnd As Long Const SC_CLOSE = &HF060 Const MF_BYCOMMAND = &H0 hwnd = Application.hWndAccessApp Dim hMenu As Long hMenu = GetSystemMenu(hwnd, 0&) If hMenu Then DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND 'Disable the Close button ááÇáÛÇÁ ' DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá End If End Sub Sub enableCloseButtonfunction() Dim hwnd As Long Const SC_CLOSE = &HF060 Const MF_BYCOMMAND = &H0 hwnd = Application.hWndAccessApp Dim hMenu As Long hMenu = GetSystemMenu(hwnd, 0&) If hMenu Then ' DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND 'Disable the Close button ááÇáÛÇÁ DrawMenuBar (hwnd) 'Repaint the MenuBar ááÊÔÛíá End If End Sub '----------------------------------------------------------------------------------------------- هذا هو الحل للفائده

لا مش حتنفع المصفوفه جرب الطريقة دي اكثر مرونة لكن الكود اطول وممكن تشيغل باقى المتغيرات غير المطلوبة Option Compare Database Public Function ReplaceCharacters() Dim db As Database Dim tblDef As TableDef Dim fld As Field Dim rs As Recordset Dim oldChar1 As String Dim newChar1 As String Dim oldChar2 As String Dim newChar2 As String Dim oldChar3 As String Dim newChar3 As String Dim oldChar4 As String Dim newChar4 As String Dim oldChar5 As String Dim newChar5 As String Dim selectedTable As String Dim replaceCount As Long ' تحديد الحروف التي تريد استبدالها oldChar1 = "عبد " newChar1 = "عبد" oldChar2 = "ى" newChar2 = "ي" oldChar3 = "أ" newChar3 = "ا" oldChar4 = "إ" newChar4 = "ا" oldChar5 = "آ" newChar5 = "ا" ' الحصول على اسم الجدول المحدد من combobox selectedTable = Me.tabelscombo.Value ' تأكد من تغيير "tabelscombo" بالاسم الصحيح لل combobox الخاص بك ' افتح قاعدة البيانات Set db = CurrentDb ' التحقق من أن الجدول المحدد صالح On Error Resume Next Set tblDef = db.TableDefs(selectedTable) On Error GoTo 0 If tblDef Is Nothing Then MsgBox "الجدول المحدد غير صالح!", vbExclamation Exit Function End If ' إعادة تعيين العداد replaceCount = 0 ' حلقة عبر جميع الحقول في الجدول المحدد For Each fld In tblDef.Fields ' تجاهل أي حقل حاسوبي If Not fld.Attributes And dbAutoIncrField Then ' تأكيد على أن الحقل يحتوي على بيانات قابلة للبحث والاستبدال If fld.Type = dbText Or fld.Type = dbMemo Then ' التحقق من أن الحقل يحتوي على نص ' استبدال الحرف الأول في القيمة الحالية للحقل Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar1 & "*'") Do While Not rs.EOF rs.Edit Dim replacedText As String replacedText = Replace(rs(fld.Name).Value, oldChar1, newChar1) If replacedText <> rs(fld.Name).Value Then rs(fld.Name).Value = replacedText replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد End If rs.Update rs.MoveNext Loop rs.Close ' استبدال الحرف الثاني في القيمة الحالية للحقل Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar2 & "*'") Do While Not rs.EOF rs.Edit Dim replacedText As String replacedText = Replace(rs(fld.Name).Value, oldChar2, newChar2) If replacedText <> rs(fld.Name).Value Then rs(fld.Name).Value = replacedText replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد End If rs.Update rs.MoveNext Loop rs.Close ' استبدال الحرف الثالث في القيمة الحالية للحقل Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar3 & "*'") Do While Not rs.EOF rs.Edit Dim replacedText As String replacedText = Replace(rs(fld.Name).Value, oldChar3, newChar3) If replacedText <> rs(fld.Name).Value Then rs(fld.Name).Value = replacedText replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد End If rs.Update rs.MoveNext Loop rs.Close ' استبدال الحرف الرابع في القيمة الحالية للحقل Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar4 & "*'") Do While Not rs.EOF rs.Edit Dim replacedText As String replacedText = Replace(rs(fld.Name).Value, oldChar4, newChar4) If replacedText <> rs(fld.Name).Value Then rs(fld.Name).Value = replacedText replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد End If rs.Update rs.MoveNext Loop rs.Close ' استبدال الحرف الخامس في القيمة الحالية للحقل Set rs = db.OpenRecordset("SELECT * FROM [" & selectedTable & "] WHERE [" & fld.Name & "] LIKE '*" & oldChar5 & "*'") Do While Not rs.EOF rs.Edit Dim replacedText As String replacedText = Replace(rs(fld.Name).Value, oldChar5, newChar5) If replacedText <> rs(fld.Name).Value Then rs(fld.Name).Value = replacedText replaceCount = replaceCount + 1 ' زيادة العداد بمقدار واحد End If rs.Update rs.MoveNext Loop rs.Close End If End If Next fld ' إغلاق قاعدة البيانات db.Close ' عرض رسالة الاستبدال بمقدار العداد MsgBox "تمت عملية الاستبدال بنجاح! تم استبدال " & replaceCount & " حرفًا.", vbInformation End Function

سنجرى عملية استبدال وساضيفها للكود

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

استبدل (عبد ) بـ (عبد) اى عبد بعدها مسافة ب عبد بدون مسافة وبامكانك فعل زلك فى ابو ابو علي مثلا استبدل (ابو ) بـ (ابو)