بحث مخصص من جوجل فى أوفيسنا
Custom Search

ياسر العربى

أوفيسنا
  • Content count

    1,496
  • تاريخ الانضمام

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

  • Days Won

    34

ياسر العربى last won the day on December 5 2016

ياسر العربى had the most liked content!

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

1,686 Excellent

عن العضو ياسر العربى

  • الرتبه
    الحمد لله

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    Nothing
  • Location
    مصر
  • Interests
    الحمد لله

اخر الزوار

2,223 زياره للملف الشخصي
  1. وطول عمرى كسول :) وحتى كسلت اعلن عن المتغيرات المهم اللي يعدل علينا حبايبنا تسلملي حبيبي تحياتي لك
  2. تفضل هذا الموضوع http://yasserelaraby86.blogspot.com.eg/2016/10/split-text-number.html تحياتي
  3. جرب المرفق لعله المطلوب تحياتي pc.rar
  4. الاخ والاستاذ الكريم محمود الشريف تحياتي لكم وكيف اخباركم هذه المشاركة فقط لايصال سلام الاخ العزيز حسام عيسى الصقر لكم تحياتي لكم
  5. الموضوع بسيط بالدالة SUBTOTAL تفضل اما بخصوص ظهور الصفر من عدمه لم افهم طلبك هل تحتاج الصفر ام لا ؟ جمع مع فلترة.rar
  6. اتفضل التكه ويبقى كدا رضا Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x For sh = LBound(arr) To UBound(arr) Sheets(arr(sh)).Range("A9:V" & Sheets(arr(sh)).Cells(Rows.Count, 1).End(xlUp).Row).ClearContents Next End If MsgBox "Done....(-_-)..." End Sub تحياتي
  7. تفضل حبيبي Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String, msg As String, x Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next msg = MsgBox("هل تريد طباعة الشيتات", vbYesNo, "امر طباعة") If msg = vbYes Then x = InputBox("عدد مرات الطباعة", "عدد نسخ الطباعة") Sheets(arr).PrintOut Copies:=x End If MsgBox "Done....(-_-)..." End Sub تحياتي
  8. تفضل بيان بمعلمى المدرسة وتخصصاتهم.rar
  9. بعد اذن الاخوة الكرام تفضل اخي تعديل بسيط لتطبيق على الشيتات دفعه واحده Private Const Nm As String = "dd.jpg" Public Sub Ali_Pr() Dim Pth As String Dim arr(), sh arr = Array(5, 6, 7, 8, 9, 10, 11, 12, 13) For sh = LBound(arr) To UBound(arr) Pth = ThisWorkbook.Path & Application.PathSeparator & "\" & Nm Sheets(arr(sh)).PageSetup.CenterHeaderPicture.Filename = Pth With Sheets(arr(sh)).PageSetup .CenterHeader = "&G" If .Orientation = xlPortrait Then .HeaderMargin = Application.InchesToPoints(3) ElseIf .Orientation = xlLandscape Then .HeaderMargin = Application.InchesToPoints(3.5) End If End With Next MsgBox "Done....(-_-)..." End Sub الشيتات المراد التعديل عليها داخل مصفوفة تستطيع تحديد اي شيتات تريد تحياتي
  10. تفضل تنبيه في حالة ادخال ارقام اقل واكبر.rar
  11. تفضل لعله المطلوب عدم تكرار.rar
  12. الموضوع بسيط عدل كما بالصورة وخصوصا رؤوس الاعمدة في الشيت الاول والشيت الثاني حتى يكونا متطابقان من حيث رؤوس الاعمدة وفي الخلايا باللون الاخضر في اعلى الشيت نقوم بوضع شرط البحث او عمود البحث الذي نريد البحث فيه ولا يوجد تعديل بالكود في هذه الحالة وشكرا.
  13. تفضلوا مشاركة منى بالاكواد Sub Test() Dim numx As Long, x As Long, z As Long, bb As Byte Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents bb = Range("D1").Value numx = bb numl = Range("F1").Value ReDim y(1 To numl, 1 To 1) For x = 1 To numl If x = numx Then numx = numx + bb: GoTo 86 If x <> numx Then z = z + 1 y(z, 1) = x End If 86 Next If z > 0 Then Cells(1, 1).Resize(z, 1).Value = y() MsgBox "Done..... (-_-)" End Sub نقوم بوضع الرقم المراد تخطيه وتخطى مضاعفاته ونضع اخر رقم بالسلسلة الرقمية ونقوم بتنفيذ الكود تحياتي special_sequence.rar
  14. مشكور اخي الغالي ا زيزو تفضل اخى الكريم احمد If IsNumeric(Range("BY" & x).Value2) Then If Range("BY" & x) <> "" Or Range("BY" & x) <> "" Then Range("CA" & x) = Range("BY" & x).Value + Range("BZ" & x).Value Else Range("CA" & x) = "" End If Else Range("CA" & x) = "" End If 'ضع الكود قبل كلمة next Next ضع هذا الكود كما هو مذكور قبل كلمة next