طير البحر

7 hours ago, عبد اللطيف سلوم said:

اعطينا مثال للتطبيق عليه

فى الجدول مطلوب ان تكون قيمة totalafter هى ناتج لعملية جمع المبلغ المودع او طرح المبلغ المسحوب بالاضافة للرصيد السابق فى
السجل الذي قبله
ممكن انجازها بالكود 
لكن سؤالي هل يمكن بطريقى ما جعل الحقل محسوب فى الجدول نفسه
وسارفق الطريقة التى اتبعتها برمجيا ايضا فى ملف totaltest

totalafter.accdb totaltest.accdb

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

هل من مساعدة

30 minutes ago, Foksh said:

لاحظت أن المشكلة في ان النموذج الفرعي يفقد مصدر سجلاته ، فقمت بتعديل بسيط ، جرب المرفق التالي :-

Fillter.accdb

 

اشكرك اخي 
والحل مناسب جدا لاستكمال العمل 
لكن لى سؤال بسيط لماذا يفقد النموذج مصدر سجلاته 

2 minutes ago, Foksh said:

طيب يا صديقي ، ممكن تفسر أكتر المشكلة بعد ما تلغي الفلترة بالجملة دي ؟؟

 

بعد الضغط على اى فلتر قم الغاء الفلتر 
جرب تغيير مثلا السنه الماليه الى 2015
لن يستجيب 
 

2 hours ago, Foksh said:

جرب أخي @طير البحر

 

filtererr.accdb 724 kB · 1 download

لا جديد اخي المشكلة قائمة ولم تعطيني فكرة عن التغييرات التى اجريتها

الاخوة @ابو جودي @Foksh
اليكم المرفق
وهذه هى الفلاتر المطبقة فى هذه الازرار
 
 

filtererr.accdb

الاخوة الافاضل لديا نموذج بحث واحتاج لتطبيق بعض الفلاتر على النتائج مثل 
Me.Child1.Form.Filter = "sheekbaky <> 0"
Me.Child1.Form.FilterOn = True
واعود فالغي الفلتر
Me.Child1.Form.FilterOn = false
فيتم الغاؤه بشكل سليم وتعود النتائج المفلترة للعرض
وبعدها لا يقبل النموذج الفرعي عرض اى نتائج جديدة 
وبدون اى رسائل خطأ
الا اذا غلقت الفورم وفتحته مرة اخرى
هل من حل

عادت للعمل بعد تنصيب اوفيس من جديد
اشكرك اخي

من فضلكم اخواني
هل يمكن تعيين الخاصيات كما فى المثال للكومبو بوكس فى اكسس ام لا
ام الاصدار الذي لدي به مشكلة
 

Me!PersonalInfo.Enabled = True 
Me!PersonalInfo.Locked = False 

حيث وجدت انه لا يمكن استخدام اى شئ مع الكومبو بوكس الا value فقط

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

dboptions.rar

https://answers.microsoft.com/en-us/msoffice/forum/all/اعاني-من/af241c23-7169-4875-bac8-edf57e7b2b33

2 hours ago, Foksh said:

وكملاحظة لم اقم بتعديلها وتركتها لك لاكتشافها 😉 

1. إيقاف قوائم اكسيس ، وإيقاف القوائم المختصرة تعمل بالعكس

2. ستجد بعض رسائل الخطأ قد ظهرت وتحتاج الى تلافيها حسب الكود الخاص بك ، فلم أطلع كثيراً على تسلسل الأحداث في الأكواد بتمعن 

😊

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

1 hour ago, Foksh said:

عمل رائع تبارك الله ما شاء الله تبارك الرحمن أخي @طير البحر 

بداية لي ملاحظة ، ظهور خطأ كما في الصورة :-

 

ثانياً لدي اقتراح بما أن هناك العديد من الخصائص تحتاج لإعادة تشغيل آكسيس ، هذا الكود :-

Sub RestartAccess()
    Dim batContent As String
    batContent = "@echo off" & vbCrLf & _
                 "ping -n 2 127.0.0.1 > nul" & vbCrLf & _
                 "start """" """ & CurrentProject.FullName & """" & vbCrLf & _
                 "exit"
    Dim batFilePath As String
    batFilePath = CurrentProject.Path & "\Restart.bat"
    Open batFilePath For Output As #1
    Print #1, batContent
    Close #1
    Shell batFilePath, vbHide
    Application.Quit
End Sub

 

أشكرك على الأفكار الشبابية الجميلة 

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

الاخ @Foksh مرفق نسخة معدلة لكن ارجو ضبط موضوع اعادة التشغيلواعادة الارسال

dboptions.rar

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

dboptions.rar

cleantabeles.rar

1 hour ago, 2saad said:

شكرا استاذي الفاضل 

أنا بدلت الكود القديم بالجديد 

وعند التطبيق 

تمام في حذف المسافات

ولكن عند تطبيق تبديل الخمسة اشياء  يعطيني خطأ في الكود

مرفق لحضرتك الملف بعد تبديل الكودcleantabeles.accdb

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

cleantabeles.rar

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

2 minutes ago, Foksh said:

😉

اقصد هذا السطر يا صديقي

hMenu = GetSystemMenu(hwnd, 1&)

 

تسلم

8 minutes ago, Foksh said:

عمل جيد أخي @طير البحر  

ودعماً لمحاولتك ، هذا الجزء الخاص بزر RestoreDown

Sub DisableRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M And Not WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
End Sub

Sub RestoreRestoreDownButton()
    Dim hwnd As Long
    Dim M As Long

    hwnd = Application.hWndAccessApp
    M = GetWindowLong(hwnd, GWL_STYLE)
    M = M Or WS_MAXIMIZEBOX
    Call SetWindowLong(hwnd, GWL_STYLE, M)
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

إلى هذا الجزء

    Sub enableCloseButtonfunction()
Dim hwnd As Long

Const SC_CLOSE = &HF060
Const MF_BYCOMMAND = &H0

 hwnd = Application.hWndAccessApp
    Dim hMenu As Long
    hMenu = GetSystemMenu(hwnd, 1&)
    If hMenu Then
        DrawMenuBar (hwnd)
    End If
    End Sub

 

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

بمجرد نقلي قاعدة اكسس من جهازي الشخصي الى جهاز المكتب
ظهرت العديد من الاخطاء
تم تجاوز بعض الاوامر فى الوظيفة المعينة لملف 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

'-----------------------------------------------------------------------------------------------

هذا هو الحل للفائده 

On 4/20/2024 at 5:02 PM, 2saad said:

شكرا لحضرتك 

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

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

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

4 hours ago, Foksh said:

مجرد سؤال أخي @2saad ، لو كان الاسم " عبد ربه" 😅 ، فما الحل ؟

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

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

 استبدل (عبد )
بـ (عبد)

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

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

التطبيق بالمرفقات

tablescleaner.rar