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

وهذه مشاركتي مع اخواني Loop.accdb

السلام عليكم استاذ ابو عبد الله طلبك هو تسلسل يعتمد على تغير الرقم والحرف بهذه الحالة هناك طريقتين الاولى : ثبات الحرف وتغير الرقم وصولا الى الرقم 99999 ثم يبدا الترقيم من جديد مع حرف جديد الثانية : ثبات الرقم وتغير الحروف وصولا الى zzzzz ثم يبدا الترقيم من جديد مع رقم جديد فالامر يشبه ورقة الاكسل الاولوية للصف ام للعمود احد الامثلة يشير الى الطريقة الاولى لكن للتاكد اي الطريقتين طلبك وعذرا للاطالة DB.rar

جرب هذا الكود: Function NextCode(PrevCode As String) As String Dim fL As String Dim sL As String Dim No As Byte 'Validation NextCode = PrevCode If Len(PrevCode) <> 4 Then Exit Function If Not IsNumeric(Right(PrevCode, 2)) Then Exit Function fL = Mid(PrevCode, 1, 1) sL = Mid(PrevCode, 2, 1) No = Mid(PrevCode, 3, 2) If Not fL Like "[A-Z]" Then Exit Function If Not sL Like "[A-Z]" Then Exit Function 'Start Coding ---------------------------------- If No < 99 Then No = No + 1 NextCode = fL & sL & Format(No, "00") Exit Function End If If sL < "Z" Then No = 1 sL = Chr(Asc(sL) + 1) NextCode = fL & sL & Format(No, "00") Exit Function End If If fL < "Z" Then No = 1 fL = Chr(Asc(fL) + 1) NextCode = fL & sL & Format(No, "00") 'Exit Function End If End Function Sub test() Dim Seq As Integer Dim NewCode As String NewCode = "AA00" For Seq = 1 To 10000 NewCode = NextCode(NewCode) Debug.Print NewCode If NewCode = "ZZ99" Then Exit For Next Seq End Sub في حالة أن أردت الرقم يبدأ من صفر بدل السطرين من No = 1 إلى No = 0

جرب هذا التعديل Private Sub CommandButton2_Click() Dim i As Long Me.ListBox1.CLEAR 'لعمل رأس الاعمدة For a = 1 To 6 Me.ListBox1.AddItem Sheet3.Cells(1, a) Next a Me.ListBox1.Selected(0) = True End Sub

وعليكم السلام-يمكنك استخدام هذه المعادلة وبما انك لم تقم برفع الملف.. على سبيل ان الرقم موجود بالخلية A2 , فستكون الإجابة أيضاً بدون ملف =CEILING(A2,0.5)

اعتقد المشكلة ايضا عند حدث فتح النموذج Private Sub Form_Open(Cancel As Integer) 'DoCmd.GoToRecord , , acNewRec Me.ass.SetFocus End Sub جربت سجل جديد ولم يحذفه

السلام عليكم - يمكنك استخدام هذه المعادلة =COUNTIF($A$2:$A$57,$H2) test.xls

المطلوب غير منطقي أريد كود (هذا اعتراف بأنه كود) وجميع الأكواد لن تعمل إلا إذا قام المستخدم بتفعيل الماكرو ربما أن يفتح الملف على شيت به صور وشرح لطريقة تفعيل الماكرو يؤدي الغرض مثل هذه الصور مع كتابة عبارات مثل : حتى يعمل الملف بصورة صحيحة يجب الضغط على زر تمكين المحتوى Enable content أو ضبط الإكسل على الموافقة على تشغيل جميع الأكواد بهذه الطريقة بالتوفيق

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

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

تفضل التعديل DB-1.rar

الكود ممتاز استاذى بارك الله فيك وجزاك خير الدارين يارب تسلم ايد استاذى بارك الله فيك كود رائع حفظك الله ورعاك

تفضل .... ناقل_3.accdb

رءوس الأعمدة لا يتم إضافتها إلى عناصر القائمة وإنما تكون عبارة عن تسميات labels أعلى القائمة تفضل هذا ملفك بعد التعديل إظهار نتائج البحث في listbox.xlsb

تفضل ..... ناقل_1.accdb

تكمن المشكلة في أن الأرقام التي يصدرها البرنامج لا يعتبرها الإكسل أرقاما نظرا لأنها تحتوي على رموز غريبة غير مرئية char(254) لذلك ينبغي علينا : أولا إصلاح تنسيق الأرقام ثانيا: إيجاد المفقود من سلسلة الأرقام تفضل هذا كود إجرائين للغرضين السابقين Sub mas() lr = Cells(2, 2).End(xlDown).Row Range("A1:L" & lr).NumberFormat = "General" Range("D1:D" & lr).NumberFormat = "@" Range("L1").Value = "القيم المفقودة" For n = 2 To lr Range("b" & n).Value = Replace(Range("b" & n).Value, Chr(254), "") Range("c" & n).Value = Replace(Range("c" & n).Value, Chr(254), "") Range("d" & n).Value = Replace(Range("d" & n).Value, Chr(254), "") Next n FindMissingNumbers Range("b2:b" & lr), Range("l2") End Sub Sub FindMissingNumbers(InputRange As Range, OutputRange As Range) For i = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) If InputRange.Find(i, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then OutputRange.Cells(j + 1, 1).Value = i j = j + 1 End If Next i MsgBox "Done" End Sub بعد تنفيذ الإجراء mas سيتم تعديل الأرقام والتواريخ وتغيير تنسيق رقم الحساب إلى نص لأنه يبدأ بصفر على اليسار ثم إيجاد الأرقام المفقودة ووضعها في العمود L ملحوظة: لا يوجد أرقام مفقودة في ملفك. ولتجربة الكود يمكنك حذف أي عدد من الصفوف بطريقة عشوائية وسيتم كتابتهم في العمود L بالتوفيق

خاÙ_ اخÙ_Ù_Ù_.xlsx

تم تعديل الملف جرب هذا خام اخميم.xlsx

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

هذا المثال لأخونا @Eng.Qassim انصحك فيه سهل للغاية و تستطيع فهمه و تطبيقه في برنامجك لا تبحث عن حلول معقدة

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

طريقة اخرى بإستخدام الحلقة التكرارية داخل النموذج الفرعي Dim db As DAO.Database Dim rs As DAO.Recordset Dim LineNumber As Integer LineNumber = 0 Set db = CurrentDb Set rs = [Forms]![date_napsa]![WORKERS_DETAILS Subform].Form.Recordset rs.MoveFirst Do Until rs.EOF [Forms]![date_napsa]![WORKERS_DETAILS Subform]![discount_napsa] = [discount_napsa_main] rs.MoveNext Loop napsa.mdb napsa.zip

أعتقد أن هذا المطلوب تمت الإجابة عليه مرتين (بالمعادلات وبالكود) قبل ذلك

عليكم السلام تفضل التعديل ارجو ان يكون طلبك napsa-1.rar

عشان لا تكون الأرقام صحيحة و لا تجبر الكسور يجب تحويل المتغيير الى Double مرفق الملف بعد التعديل دالة.accdb

جرب الآن دالة_جمع.accdb

وعليكم السلام ورحمة الله وبركاته بالاضافة الى ما تفضل به الاخوة الكرام ولهم جزيل الشكر وبحسب ترتيب حروف " ابجد هوز حطي كلمن " وكما هو موجود بالنموذج 14 حرف وكما هو موضح بمثالك ( الحرف الاول - الحرف الثاني ... الخ ) يكون الكود كالتالي Option Compare Database Option Explicit Private Sub XTotal_Exit() If Me.A = "ا" Then Me.A1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.A & "'") Else Me.A1 = 0 End If If Me.B = "ب" Then Me.B1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.B & "'") Else Me.B1 = 0 End If If Me.C = "ج" Then Me.C1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.C & "'") Else Me.C1 = 0 End If If Me.D = "د" Then Me.D1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.D & "'") Else Me.D1 = 0 End If If Me.E = "ه" Then Me.E1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.E & "'") Else Me.E1 = 0 End If If Me.F = "و" Then Me.F1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.F & "'") Else Me.F1 = 0 End If If Me.G = "ز" Then Me.G1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.G & "'") Else Me.G1 = 0 End If If Me.H = "ح" Then Me.H1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.H & "'") Else Me.H1 = 0 End If If Me.I = "ط" Then Me.I1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.I & "'") Else Me.I1 = 0 End If If Me.J = "ي" Then Me.J1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.J & "'") Else Me.J1 = 0 End If If Me.K = "ك" Then Me.K1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.K & "'") Else Me.K1 = 0 End If If Me.L = "ل" Then Me.L1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.L & "'") Else Me.L1 = 0 End If If Me.M = "م" Then Me.M1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.M & "'") Else Me.M1 = 0 End If If Me.n = "ن" Then Me.n1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.n & "'") Else Me.n1 = 0 End If Me.tot.Value = Nz(A1) + Nz(B1) + Nz(C1) + Nz(D1) + Nz(E1) + Nz(F1) + Nz(G1) + Nz(H1) + Nz(I1) + Nz(J1) + Nz(K1) + Nz(L1) + Nz(M1) + Nz(n1) ' Debug.Print Me.tot End Sub Private Sub A_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub b_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub c_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub d_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub e_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub f_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub g_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub h_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub i_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub j_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub k_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub l_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub m_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub n_Exit(Cancel As Integer) Call XTotal_Exit End Sub 001.rar تحياتي

لقد عملت نسخة من النموذج وعدلت عليه وتركت الأصل كما هو للمقارنة. أبجد_هوز.mdb

الامر سهل انظر الى مواقع الاسهم في الصورة واضغط على النقاط الثلاث في الصورة مكان السهم يظهر لك استعلام لبيانات مربع القائمة ... طبق على مثالك ..

استكمال للرد السابق من المعروف ان التعديل ممكن ان يعمل بشكل يدوي مثل الصورة اول مشاركة لي في الموضوع وبعد التعديل نفتح الريجستري ثم نضع المؤشر على International ثم تصدير ولكن هذه الطريقة تقوم بتصدير كافة الاعداد الاقليمية وهذا مالا نريده فاذا اردنا ان نعمل ملف ريجيستري يقتصر عمله على تعديل تنسيق الارقام نستخدم الكود التالي Windows Registry Editor Version 5.00 [HKEY_CURRENT_USER\Control Panel\International] "sNativeDigits"="0123456789" "NumShape"="1" ويمكن ان يقاس الامر على اي تعديل واذا اردنا التعديل عن طريق ملف دفعي يكتب الكود بالشكل التالي reg add "HKCU\Control Panel\International" /f /v sNativeDigits /t REG_SZ /d "0123456789" >nul reg add "HKCU\Control Panel\International" /f /v NumShape /t REG_SZ /d "1" >nul لكتابة ملفات الريجستري والملفات الدفعية نستخدم مفكرة الويندوز او اي برنامج نصي مثل ++ Notepad وهو الافضل لسهولة التعديل تحياتي

الشكر لله اخي ابو اشرف طيب بالنسبة للعميل هل ستطلب منه اجراء التعديل الافضل ان نعمل احد الامرين اذا كان لديك خبرة في التعامل مع ملفات الرجيستري ممكن نعمل ملف reg يتم تشغيله على جهاز العميل يقوم باجراء كافة التعديلات الخاصة باللغة والمنطقة والارقام وصيغة التاريخ جميعها او اي منها ** وللوصول للنتيجة الصحيحة عندما نرغب بعمل ملف ريجستري لتعديل تنسيق الارقام نحتاج الى تغيير قيمتين ضمن تبويب International في الرجيستري NumShape = 1 sNativeDigits = 0123456789 وهذة هي طريقتي اعمل ملف دفعي bat يعمل عن طريق نقطة الاوامر بنظام التشغيل dos يقوم بالاتي تغيير الاعداد المشار اليها اعلاه يقوم بعمل اختصار للبرنامج على سطح المكتب تخفيض امان الماكرو الطريقة الثانية عن طريق كود قام الاستاذ الفاضل @SEMO.Pa3x " د.حسنين " بتعديله ليشمل تعديل تنسيق الارقام اضافة الى امور اخرى 👇 في جميع الاحوال طريقة الدكتور حسنين اكثر امان وبالذات لمن ليس لديه خبرة كافية بالتعامل بالباتشات ومشاكل تعديلات الريجستري ـــــــــــــــــــــــــــــــــــــــــــــــــ * لا انصح باجراء التعديلات لمن ليس لديه الخبرة واخلي مسئوليتي عن اي خطأ ** احتفظ بنسخة من الريجستري قبل اي تعديل يجنبك عناء اعادة تنصيب نظام التشغيل

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

أشك في ضبط إعدادات اللغة العربية في الويندوز حاول تنفيذ هذه الخطوات Control panel --> clock and region --> change date, time, number formats --> administrative - current languge for non-Unicode programs تأكد أنها اللغة العربية وإذا قمت بتغييرها سيتم عمل إعادة تشغيل للجهاز بالتوفيق

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

العبارة مع الاستعلام يعملان بالتعدل الظاهر في الصورة لدي بدون مشاكل ... تفضل الملف بعد التعديل .... New (5).rar

شوف الصورة

لن تحصل على شيء لأن العمود Q فارغ للعلم الدالة cells تستعمل في التعامل مع النطاقات مثلها مثل range ولكن الفرق أن range نقدم لها اسم النطاق مثلا range("c5").value = "Mas" هذا الكود يقوم بكتابة Mas في الخلية C5 ويمكن استعمال cells لنفس الغرض cells(5, 3).value = "Mas" حيث أن 5 هو رقم الصف و3 هو رقم العمود فعند كتابتك رقم 17 في خانة العمود فأنت تقصد العمود Q بالتوفيق

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

حسب فهمي انك تريد عد ايام الغياب التي تم التاشير عليها واضافة لما اشار اليه الاستاذ @محمد أبوعبدالله استخدام معيار حقل نصي يختلف عن الحقل الرقمي حقل s في اكثر من جدول في نفس الاستعلام فاما تستخدم اسم الجدول في المعيار كما فعل استاذنا محمد او نستخدم اسم مستعار كما عملت انا ايضا وحسب فهمي فنحن نحتاج الى اضافة معيار اخر يتضمن حقل غائب يساوي نعم DCount("*";"22";"[s]='" & [a].[s] & "'" & "and[geab]=true") الملف مرفق ASD1231.accdb بصفة عامة توجد طرق تعطي نتيجة اسرع من استخدام الدالة مباشرة في الاستعلام ولكن لا اجد الوقت للتعديل

السلام عليكم انت تريد عدد حقل prop وهذا الحقل غير موجود في جدول2 والصحيح ان يكون geab والمعادلة كالتالي abs: DCount("[geab]";"22";"[s]='" & [1]![S] & "'") ASD123.accdb تحياتي

هذا الموضوع يفيدك

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

تفضل هذا مطلوبك الثاني Sub tar7eel() For n = 2 To Cells(Rows.Count, 9).End(xlUp).Row If Range("i" & n).Value = Range("d2").Value Then Range("j" & n).Value = Range("e2").Value Next n End Sub بالتوفيق

حسب فهمي للمطلوب يمكنك استعمال الإجراء التالي وربطه بزر أو شكل أو صورة Sub tar7eel() Range("j2").Value = Range("e2").Value End Sub ومتى تريد تحديث قيمة J2 يتم الضغط على الزر وتنفيذ الإجراء

اذا كان لديك حقل حسابي استخدم الدالة NZ لتجعل الحقل الفارغ صفر حتى لايسبب لك مشاكل اما اذا تقصد نفس الحقل فأستخدم IIf(IsNull([Feild1];0;[Field1]))

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

بعد إذن أخي الكريم سليم لعرض الشيتات الملونة باللون الأحمر فقط يمكنك تغيير الشرط الخاص بلون الشيت من If col Then إلى If col = RGB(255, 0, 0) Then وبالنسبة لعمل قائمة منسدلة للشيتات باللون الأزرق يمكنك استعمال نفس الكود مع تغيير اسم الكومبوبوكس وكود اللون If col = RGB(0, 0, 255) Then بالتوفيق

جرب هذا ..كل الطابعات ستكون في مربع التحرير وعند اختيار الطابعة ستكون هي الفعالة printerA.accdb

جرب هذا الكود.. لكنه يعطي خطأ اذا كانت الطابعة غير موجودة

وعليكم السلام في الجدول ... تختار نوع الحقل ... ترقيم تلقائي مع وافر الاحترام