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

من الصورة يبدو أن الخطأ ناتج عن عدم ضبط لغة الترميز Unicode الى اللغة العربية في ويندوز ، لذا أنصحك بمراجعة هذا الموضوع هنا 🤗 .

يااخى وصديقى/ فؤش انت جميل واسلوبك فى التوضيح رائع ربنا لا يحرمنا من افكارك وعلمك فى اكسس

احسنت استاذنا / محمد هشام. هذا هو المطلوب

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

=IF(SUMIFS(INDIRECT("Sheet1!$F$" & $J$2 & ":$F$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3,INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3) = 0, "", SUMIFS(INDIRECT("Sheet1!$F$" & $J$2 & ":$F$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3)) =IF(SUMIFS(INDIRECT("Sheet1!$G$" & $J$2 & ":$G$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3) = 0, "", SUMIFS(INDIRECT("Sheet1!$G$" & $J$2 & ":$G$" & $K$2),INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3)) Summary Expenses.xlsx

اليك كما تفضلت و اذا اردت عددم قفل الصفحة خلال تنقل بين سجلات في نفس الصفحة حتى انتقال الى الصفحة اخرى ، امسح حدث في الحالي نموذج . حماية الصفحة.mdb

=============================================( صور + مرفق + فيديو ) Update: 🌹 استكمال ☕ 1- تصحيح الدالة الصلاحيات للنماذج والتقارير On Error GoTo ops Dim User_Name As String Dim ID_Name As String User_Name = DLookup("[name_user]", "[Control_User]") ID_Name = DLookup("[IDDX]", "[Control_User]") 'IDDX '===========( Name_Report For Reprt Control User '==========================================(1)No use True Dim Name_X As String Name_X = FormsAllowed '==============================================(Chack frist) If IsNull(DLookup("[name_frm]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ")) Then MsgBox " Opes back setting for Error Forget this form Open Or Now Awoch ", vbCritical, "Close Done " & Date DoCmd.Close acForm, strname Exit Function End If '============================================================================( Open Form If DLookup("[open_frm]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then DoCmd.OpenForm strname End If If DLookup("[open_frm]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then MsG2 = "Sand Massage !" MsG1 = "تنبيه للمستخدم! رسالة ادارية راجع المسؤل المختص " MsG3 = "الا تملك صلاحية الدخول او ليس لك حق الدخول او تم حظرك من الدخول او تم منعك من الدخول " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 DoCmd.Close acForm, strname 'Exit Function End If '============================================================================( AllowAddition If DLookup("[add_new]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowAdditions = True End If If DLookup("[add_new]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then Forms(strname).AllowAdditions = False End If '============================================================================( AllowDeletion If DLookup("[delet]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowDeletions = True End If If DLookup("[delet]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = False Then Forms(strname).AllowDeletions = False End If '============================================================================( AllowEdits If DLookup("[editor]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowEdits = True End If If DLookup("[editor]", "[Usre_frm]", "[name_frm] ='" & strname & "' And [IDDX] =" & ID_Name & " ") = True Then Forms(strname).AllowEdits = False End If 2- اضافة عرض التقارير + بتخصيص قائمة للمستخدمين 3- اضافة اختيار ايكون للتقارير مع العنوان بقائمة الادوات Admin 4- اضافة قائمة لتهيئة التقارير وعلامة المائية لحساب المطور ...+ بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا تحميل المرفق https://www.mediafire.com/file/0nrnjkxipry23y6/Update_Fix_Add_v3_Into_4_User_Control_Open_App.rar/file

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

وعليكم السلام ورحمة الله تعالى وبركاته رغم أنني ليس متأكدا من طلبك بسبب كثرة الأكواد التي قمت بإرفاقها بالنسبة لعمود F (اجمالى ك وق) لا يمكن جمع القيم مباشرة إذا كانت مخزنة كنص باستخدام الدالة TEXT أعتقد انه يمكنك تجاوز هذه المشكلة بتعديل الكود لجمع القيم العددية مباشرة دون الحاجة إلى الصيغة TEXT مع الاحتفاظ بالصيغ في الأعمدة الأخرى Option Explicit Sub Test() Dim WS As Worksheet, dest As Worksheet, dict As Object Dim Code, name, Unit As String Dim cartn, Price, tmp, ColF As Double Dim ColArr, col, key, ColHard As Variant Dim lastRow, i, Irow As Long Set WS = Sheets("Sheet3"): Set dest = Sheets("رصيد") lastRow = WS.Cells(Rows.Count, 7).End(xlUp).Row If lastRow < 2 Then Exit Sub ColHard = Array("كود الصنف", "اسم الصنف", "وحدة الصنف", "سعر الصنف", "عدد الكراتين", "إجمالي ك وق", "ك", "ق") With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With dest.Range("A2:H" & dest.Rows.Count).ClearContents Application.ErrorCheckingOptions.BackgroundChecking = False Set dict = CreateObject("Scripting.Dictionary") Irow = 2 For i = 2 To lastRow Code = Trim(CStr(WS.Cells(i, 7).value)) name = Trim(WS.Cells(i, 6).value) Unit = Trim(WS.Cells(i, 4).value) Price = Val(WS.Cells(i, 5).value) cartn = Val(WS.Cells(i, 3).value) If Code <> "" Then If dict.Exists(Code) Then dict(Code)(3) = dict(Code)(3) + cartn Else dict.Add Code, Array(name, Unit, Price, cartn) End If End If Next i With dest .Range("A1:H1").value = ColHard For Each key In dict.Keys .Cells(Irow, 1).value = key .Cells(Irow, 2).Resize(1, 4).value = dict(key) .Cells(Irow, 7).Formula = "=INT(E" & Irow & "/C" & Irow & ")" .Cells(Irow, 8).Formula = "=MOD(E" & Irow & ",C" & Irow & ")" Irow = Irow + 1 Next key .Cells(Irow, 1).value = "المجموع الكلي" ColF = 0 For i = 2 To Irow - 1 If .Cells(i, 5).value <> 0 And .Cells(i, 3).value <> 0 Then tmp = Int(.Cells(i, 5).value / .Cells(i, 3).value) + (.Cells(i, 5).value Mod _ .Cells(i, 3).value) / .Cells(i, 3).value Else tmp = 0 End If .Cells(i, 6).value = Format(tmp, "0.0") ColF = ColF + tmp Next i .Cells(Irow, 6).value = Format(ColF, "0.0") ColArr = Array("E", "G", "H") For Each col In ColArr .Cells(Irow, col).Formula = "=SUM(" & col & "2:" & col & (Irow - 1) & ")" Next col End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With MsgBox "تمت العملية بنجاح", vbInformation End Sub اجمالى2 V1.xlsm