اذهب الي المحتوي
أوفيسنا

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

المشرفين السابقين
  • Posts

    13,165
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    411

ياسر خليل أبو البراء last won the day on سبتمبر 15 2023

ياسر خليل أبو البراء had the most liked content!

السمعه بالموقع

7,719 Excellent

عن العضو ياسر خليل أبو البراء

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    Teacher
  • البلد
    مصر
  • الإهتمامات
    Programming - Chess

وسائل التواصل

  • MSN
    yahk777@hotmail.com
  • Yahoo
    yakh777@yahoo.com

اخر الزوار

24,196 زياره للملف الشخصي
  1. السلام عليكم نبدأ بها جرب الكود التالي 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
  2. ما المشكلة في استخدام الدالة Trunc .. إن الدالة تعطيك الرقم الصحيح ولا يوجد أية كسور الرجاء توضيح المشكلة بمزيد من الأمثلة والمنطق المتبع في الحل.
  3. أخي العزيز محمد هشام أهناك شيء مختلف في الكود الموضوع في الملف المرفق الخاص بكم؟
  4. وعليكم السلام 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
  5. ولتجنب استخدام جملة 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
  6. وعليكم السلام ورحمة الله وبركاته جرب الكود التالي عله يفي بالغرض 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
  7. ارفق المثال الذي تعمل عليه بالضبط أو حاول بنفسك تغيير النطاق فقط في المعادلة المستخدمة في ورقة العمل
  8. وعليكم السلام أخي الكريم أدرج موديول جديد وضع الدالة المعرفة التالية في الموديول 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 إلى آخر النطاق قبل وضع المعادلة
  9. وعليكم السلام جرب الكود التالي 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
  10. بارك الله فيكم إخواني الكرام ومشكور على مروركم العطر وجزيتم خيراً على دعواتكم المباركة لوالدي رحمة الله عليه
  11. السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم الملف التالي وهو ببساطة ملف يتم فيه تسجيل الغياب اليومي بشكل سهل ومرن ، ومن خلاله يمكنك الحصول على تقارير لأيام الغياب لأي أسبوع وهو مفيد لشئون الطلبة ومسئولي الحكومة الإلكترونية في التعامل مع خدمة تسجيل الغياب الأسبوعي. وسأترك الشرح بالتفصيل للأخ العزيز / عماد غازي ، وإليكم رابط الفيديو الخطوة الأولي: فك الضغط عن الملف المضغوط ستجد ملف باسم Dummy.xlsx هذا الملف يتم وضع بيانات المدرسة فيه (كود الطالب - اسم الطالب - الصف - الفصل) والملف الثاني ملف برنامج السجل الالكتروني قم بفتحه ونفذ الأمر GETDATA مرة واحدة فقط عند أول استخدام للبرنامج ، بحيث يتم إضافة بيانات الطلاب في البرنامج ، والأمر موجود في شريط الوصول السريع على شكل جرس. أكرر هذا الأمر يقوم بمسح البيانات في البرنامج من قاعدة البيانات DB بالكامل ، لذا وجب التنبيه أن هذا الأمر يتم تنفيذه مرة واحدة فقط عند استخدام البرنامج لأول مرة. تم إضافة ورقة عمل باسم HP فيها تعليمات كيفية التعامل مع البرنامج ، يرجى قراءة التعليمات جيداً قبل التعامل مع البرنامج ** في انتظار إضافاتكم ومقترحاتكم واستفساراتكم حول كيفية استخدام البرنامج أو الإبلاغ عن أي خطأ لكي يتم معالجته إن شاء الله تم تحديث الملف المرفق بتاريخ 6 أكتوبر 2023 الساعة 06:00 مساءاً أسألكم الدعاء لوالدي الذي رحل عن الدنيا ، أسأل الله له المغفرة والرحمة والفردوس الأعلى من الجنة ، وسأعتبر هذا البرنامج صدقة جارية على روح والدي. أخوكم في الله / ياسر خليل أبو البراء رابط الموضوع الأصلي من هنا https://techno7asry.com/forum/t6265
×
×
  • اضف...

Important Information