ياسر خليل أبو البراء

السلام عليكم نبدأ بها جرب الكود التالي Sub Test() Dim ws As Worksheet, sh As Worksheet, sTarget As String, lr As Long, m As Long, iRow As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("اذن") lr = ws.Cells(Rows.Count, 1).End(xlUp).Row If lr < 6 Then MsgBox "No Data", vbExclamation: Exit Sub Select Case ws.Range("C2").Value Case "اذن صرف": sTarget = "صرف" Case "اذن اضافه": sTarget = "اضافه" Case Else: MsgBox "No Such Worksheet", vbExclamation: Exit Sub End Select Set sh = ThisWorkbook.Worksheets(sTarget) m = sh.Cells(Rows.Count, "B").End(xlUp).Row + 1 For iRow = 6 To lr sh.Range("A" & m).Resize(, 6).Value = Array(sh.Range("A" & m).Row - 2, ws.Range("E2").Value, ws.Range("C4").Value, ws.Range("C3").Value, ws.Cells(iRow, 1).Value, ws.Cells(iRow, 2).Value) sh.Range("I" & m).Value = ws.Cells(iRow, 4).Value If sh.Name = "اضافه" Then sh.Range("J" & m).Value = ws.Cells(iRow, 5).Value End If m = m + 1 Next iRow Application.ScreenUpdating = True MsgBox "Done", 64 End Sub

ما المشكلة في استخدام الدالة Trunc .. إن الدالة تعطيك الرقم الصحيح ولا يوجد أية كسور الرجاء توضيح المشكلة بمزيد من الأمثلة والمنطق المتبع في الحل.

وعليكم السلام =TRUNC(E1*F1/G1,0)

أخي العزيز محمد هشام أهناك شيء مختلف في الكود الموضوع في الملف المرفق الخاص بكم؟

الكود يعمل على كل الصفحات بالمصنف

وعليكم السلام Sub Test() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets ws.Rows("1:2").RowHeight = 30 ws.Rows("3:" & Rows.Count).RowHeight = 20 Next ws End Sub

ولتجنب استخدام جملة On Error Resume Next يمكن تعديل الكود بهذا الشكل Sub Test2() Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws If .AutoFilterMode Then .AutoFilterMode = False If .FilterMode = True Then .ShowAllData End If End With Next ws Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمة الله وبركاته جرب الكود التالي عله يفي بالغرض Sub Test() Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets If ws.AutoFilterMode Then On Error Resume Next ws.ShowAllData On Error GoTo 0 End If Next ws Application.ScreenUpdating = True End Sub

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

وعليكم السلام أخي الكريم أدرج موديول جديد وضع الدالة المعرفة التالية في الموديول Function xDupsV(fCol As Range, Optional offsetCol As Integer = -1) Dim a, r1 As Range, r2 As Range, c As Range, cc As Range, i As Long, j As Long Application.Volatile True Set r1 = fCol Set r2 = r1.Offset(, offsetCol) ReDim a(1 To 1) For Each c In r1 Set cc = c.Offset(, offsetCol) If Not IsEmpty(c) And cc > 0 Then For j = 1 To cc i = i + 1 ReDim Preserve a(1 To i) a(i) = c Next j End If Next c xDupsV = WorksheetFunction.Transpose(a) End Function ثم في الخلية C11 ضع المعادلة بهذا الشكل =xdupsv(F3:F6) لا تنسى أن تقوم بمسح النطاق C11 إلى آخر النطاق قبل وضع المعادلة

وعليكم السلام جرب الكود التالي Private Sub UserForm_Initialize() Dim fso As Object, oFolder As Object, sPath As String, i As Long sPath = "D:\" Set fso = CreateObject("Scripting.FileSystemObject") UserForm1.ListBox1.Clear If fso.FolderExists(sPath) Then Set oFolder = fso.GetFolder(sPath) For Each oFolder In oFolder.SubFolders If Left(oFolder.Name, 1) <> "$" Then i = i + 1 UserForm1.ListBox1.AddItem oFolder.Name End If Next oFolder End If Set fso = Nothing End Sub

غير الجزء التالي If Weekday(Cells(4, i)) > 5 ليصبح If Weekday(Cells(4, i)) = 6

بارك الله فيكم إخواني الكرام ومشكور على مروركم العطر وجزيتم خيراً على دعواتكم المباركة لوالدي رحمة الله عليه

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم الملف التالي وهو ببساطة ملف يتم فيه تسجيل الغياب اليومي بشكل سهل ومرن ، ومن خلاله يمكنك الحصول على تقارير لأيام الغياب لأي أسبوع وهو مفيد لشئون الطلبة ومسئولي الحكومة الإلكترونية في التعامل مع خدمة تسجيل الغياب الأسبوعي. وسأترك الشرح بالتفصيل للأخ العزيز / عماد غازي ، وإليكم رابط الفيديو الخطوة الأولي: فك الضغط عن الملف المضغوط ستجد ملف باسم Dummy.xlsx هذا الملف يتم وضع بيانات المدرسة فيه (كود الطالب - اسم الطالب - الصف - الفصل) والملف الثاني ملف برنامج السجل الالكتروني قم بفتحه ونفذ الأمر GETDATA مرة واحدة فقط عند أول استخدام للبرنامج ، بحيث يتم إضافة بيانات الطلاب في البرنامج ، والأمر موجود في شريط الوصول السريع على شكل جرس. أكرر هذا الأمر يقوم بمسح البيانات في البرنامج من قاعدة البيانات DB بالكامل ، لذا وجب التنبيه أن هذا الأمر يتم تنفيذه مرة واحدة فقط عند استخدام البرنامج لأول مرة. تم إضافة ورقة عمل باسم HP فيها تعليمات كيفية التعامل مع البرنامج ، يرجى قراءة التعليمات جيداً قبل التعامل مع البرنامج ** في انتظار إضافاتكم ومقترحاتكم واستفساراتكم حول كيفية استخدام البرنامج أو الإبلاغ عن أي خطأ لكي يتم معالجته إن شاء الله تم تحديث الملف المرفق بتاريخ 6 أكتوبر 2023 الساعة 06:00 مساءاً أسألكم الدعاء لوالدي الذي رحل عن الدنيا ، أسأل الله له المغفرة والرحمة والفردوس الأعلى من الجنة ، وسأعتبر هذا البرنامج صدقة جارية على روح والدي. أخوكم في الله / ياسر خليل أبو البراء رابط الموضوع الأصلي من هنا https://techno7asry.com/forum/t6265

راجع الرابط جيداً أخي