أ / محمد صالح

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

أقترح عمل حقل المسلسل الطبيعي ونوع بياناته autonumber ثم إضافة حقل محسوب في الجدول ونضع هذا في التعبير الخاص به "E" & 10000+[FileNo] حيث FileNo هو حقل المسلسل الطبيعي

يمكنك استعمال هذه المعادلة في الخلية C2 =MROUND(A2,0.5) وهي تعمل على أةفيس 2007 فما فوق بالتوفيق

المطلوب الثاني غير متعلق بالموضوع ويمكنك التوصل اليه بالبحث https://www.officena.net/ib/search/?q=إغلاق الاكسل بعد فترة&updated_after=any&sortby=relevancy&search_and_or=and بالتوفيق

شكرا لكلماتك الطيبة أنا شخصيا لم اغير إلا فيما يحقق الشرط الخاص بك على اعتبار ان الكود يعمل معك قبل ذلك لذلك إذا كنت تقصد تحويل النص المكتوب في مربع النص إلى تاريخ يمكنك تعديل Me.TextBox16.Value في الشرط إلى cdate(Me.TextBox16.Value) تم تعديل الكود كاملا في المشاركة الأصلية بالتوفيق

هل تقصد إغلاق الاكسل كله إذا لم يكن هناك مصنفات مفتوحة غير هذا المصنف؟

احذف هذا السطر لأني قمت بالإعلان عن جميع المتغيرات في أول سطر والرسالة تعني تكرار إعلان عن متغير بالتوفيق

يمكنك استعمال هذا الكود في حدث قبل إغلاق الملف Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("Introduction").Range("G10") = "" Sheets("Introduction").Range("G12") = "" ThisWorkbook.Save End Sub وينبغي حفظ الملف بامتداد يسمح بالأكواد مثل xlsb بالتوفيق

حسب فهمي للمطلوب أنك تريد تعديل جميع الصفوف التي يتساوى فيها عمود التاريخ مع التاريخ المكتوب في مربع النص مرة في شيت micro ومرة في شيت raw لذلك جرب تعديل كود زر الأمر إلى ما يلي: Private Sub CommandButton1_Click() Dim ws As Worksheet, we As Worksheet, lr As Long, iRow As Long, n As Long, k As Integer, m As Integer Set ws = Worksheets("micro") lr = ws.Cells(Rows.Count, 6).End(xlUp).row For n = 1 To lr If ws.Cells(n, 6).Value = CDate(Me.TextBox16.Value) Then ws.Cells(n, 13).Value = Me.TextBox10.Value ws.Cells(n, 14).Value = Me.TextBox11.Value ws.Cells(n, 15).Value = Me.TextBox12.Value ws.Cells(n, 16).Value = Me.TextBox13.Value ws.Cells(n, 17).Value = Me.TextBox14.Value ws.Cells(n, 18).Value = Me.TextBox15.Value For k = o To ListBox2.ListCount If ListBox2.Selected(k) = True Then ws.Cells(n, 11).Value = ListBox2.List(k, 0) Exit For On Error Resume Next End If Next k End If Next n Set we = Worksheets("Raw") iRow = we.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).row For m = 1 To iRow If we.Cells(m, 6).Value = CDate(Me.TextBox16.Value) Then we.Cells(m, 16).Value = Me.TextBox10.Value we.Cells(m, 17).Value = Me.TextBox11.Value we.Cells(m, 18).Value = Me.TextBox12.Value we.Cells(m, 19).Value = Me.TextBox13.Value we.Cells(m, 20).Value = Me.TextBox14.Value we.Cells(m, 21).Value = Me.TextBox15.Value For k = o To ListBox2.ListCount If ListBox2.Selected(k) = True Then we.Cells(m, 11).Value = ListBox2.List(k, 0) Exit For On Error Resume Next End If Next k End If Next m End Sub لاحظ استعمال حلقة تكرارية لكل خلايا العمود F ورقمه 6 واستعمال المتغير N & M للتعبير عن رقم الصف الذي تساوت فيه القيم بالتوفيق

تقريبا الخطأ في أن الشرط في زر الحفظ والتعديل هو If C Like TextBox6.Value & "*" Then وهذا يعني أن الخلية تشبه الرقم وبعده أي رقم آخر * وربما يكون الصواب If c = Val(Me.TextBox6) Then وهو يعني تساوي الرقم مع الرقم المكتوب في مربع النص بالتوفيق

المطلوب غير واضح لي هل تقصد: إذا تساوت قيمة خلية في العمود f في الشيت micro يتم الترحيل في نفس الصف الذي تساوت فيه (طبعا في شيت micro) ولا يقوم بالترحيل في شيت raw وإذا تساوت قيمة خلية في العمود f في الشيت raw يتم الترحيل في نفس الصف الذي تساوت فيه ولا يقوم بالترحيل في شيت micro ؟؟؟

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

الملف به كود يقوم بالترحيل إلى أول صف فارغ بعد المكتوب في شيت micro وشيت raw هل المطلوب تعديل الترحيل في شيت micro فقط إذا تساوى التاريخ في العمود f مع مربع نص التاريخ؟ مع الترحيل إلى آخر صف في شيت raw أم أنه لا يتم الترحيل في الاثنين إلا إذا تساوى التاريخ؟

لظهور الأقواس مضبوطة ينبغي التأكد من اتجاه المستند من اليمين لليسار وكذلك اتجاه الكتابة (إذا كانت لغة الكتابة عربية) وإذا أردت الاستبدال بعد ذلك فعليك بالآتي : استبدال القوس الأول إلى رمز غريب غير مستعمل في المستند مثل # مع تنفيذ استبدال الكل استبدال القوس الثاني إلى القوس الأول مع تنفيذ استبدال الكل استبدال الرمز الغريب إلى القوس الثاني مع استبدال الكل بالتوفيق

أخي الفاضل في حدث عند فتح المصنف راجع هذا السطر Select Case MBSerialNumber وهو لاختبار حالات المتغير MBSerialNumber الذي تنتجه الدالة المعرفة MBSerialNumber الموجودة في الموديول المنفصل فإذا كانت MBSerialNumber مثل واحدة من strMB1, strMB2, strMB3 لا يفعل شيئا ويستمر في فتح المصنف وإذا كانت غير ذلك يغلق المصنف مع حفظ التغييرات بالتوفيق

يمكنك استعمال هذا الكود في حدث عند الضغط على الزر Private Sub CommandButton1_Click() Dim iRow As Long, Lastrow As Long, i As Long With ورقة1 Lastrow = .Cells(.Rows.Count, 7).End(xlUp).Row For r = 3 To Lastrow If .Cells(r, 7) = TextBox1.Value Then iRow = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row .Cells(iRow, 3).Value = Me.TextBox1.Value .Cells(iRow, 4).Value = Me.TextBox2.Value MsgBox " لقد تم الترحيل بنجاح ", vbExclamation + vbMsgBoxRight, "تم الترحيل " GoTo 1 End If Next End With MsgBox "لايوجد هذا الاسمً ", vbInformation + vbMsgBoxRight, "تنبيه" 1: TextBox1.Value = "" TextBox2.Value = "" TextBox1.SetFocus End Sub بالتوفيق

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

لا أدري أين المشكلة عندك ولكن إذا كنت تريد تطبيق ذلك على ملف آخر بامتداد xlsb أولا تفتح شاشة الفيجوال بيسك داخل اكسل ثم تضيف موديول جديد وتلصق فيه الكود الذي يتحقق من رقم الماذربورد Function MBSerialNumber(Optional strComputer As String = ".") As String Dim v, vName, vUUID With GetObject("winmgmts:\\" & strComputer & "\root\cimv2") For Each v In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48) vName = v.Name: vUUID = v.UUID Next v End With MBSerialNumber = vName & ", " & vUUID End Function ثم تضغط دبل كلك على thisworkbook وتلصق هذا الكود في حدث عند فتح الملف Private Sub Workbook_Open() Dim strMB1 As String, strMB2 As String, strMB3 As String 'Put Your MotherBoard Serial strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2" strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" Select Case MBSerialNumber Case strMB1, strMB2, strMB3 Exit Sub Case Else MsgBox ("Data Security Failure. This Workbook Will Close") ActiveWorkbook.Close 1 End Select End Sub ثم تقوم بحفظ التغييرات وتغلق وتفتح الملف مرة أخرى بالتوفيق

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

إذا كنت تقصد المعادلة في الخلية M18 فهذه تأتي بمعادلة البحث المستعملة في الشيت =VLOOKUP(D3,B26:L61,11,0) لأن خلية حالة العقد في الجدول بالأسفل تعتمد على خلية أخرى هي خلية سداد مبكر بتاريخ بالتوفيق

ملفك المرفق تم إضافة كود فتح المصنف المذكور في مشاركتك الأولى وتم حفظ الملف بامتداد xlsb وتم إغلاق الملف وفتحه فظهرت الرسالة وتم إغلاق الملف حسب الكود

حسب فهمي للمطلوب جرب هذه المعادلة في الخلية L26 =IFERROR(IF(AND(M26<>"",M26<I26),"سداد مبكر",IF(TODAY()=I26,"العقد انتهى اليوم",IF(TODAY()>I26,"العقـد منتهى",IF(TODAY()<H26,"لم يتم تداولة","العقـد سارى")))),"") تم تعديل الشرط الأول إلى ألا تكون الخلية فارغة وتكون أقل من تاريخ نهاية العقد

يمكنك استعمال هذه الدالة المعرفة Function checknum(rng As Range) For n = 1 To 100 If Sqr(rng * n + rng.Offset(0, 1)) = rng.Offset(0, 2) Then checknum = rng.Offset(0, 2): Exit Function End If Next n checknum = 0 End Function ولاستدعاء الدالة نضع في الخلية F2 =checknum(A2) ولا تنس حفظ الملف بصيغة تدعم الماكرو مثل xlsb بالتوفيق

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

جرب هذه المعادلات خساب الاقدمية.xls