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

سليم حاصبيا

أوفيسنا
  • Content Count

    7,074
  • تاريخ الانضمام

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

  • Days Won

    144

سليم حاصبيا last won the day on مارس 25

سليم حاصبيا had the most liked content!

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

5,869 Excellent

عن العضو سليم حاصبيا

  • الإسم الفعلي
    فريق الموقع
  • تاريخ الميلاد 08 مار, 1985

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

  • Gender (Ar)
    ذكر
  • Job Title
    استاذ ثانوي
  • البلد
    beiruth
  • الإهتمامات
    eXCEL

اخر الزوار

10,047 زياره للملف الشخصي
  1. ضعه في الفورم form احذف اول سطر من الكود وضع مكانه Private Sub CommandButton3_Click() اذا كان رقم الزر التنفيذ 3 او استبدل 3 برقم زر التنفيذ
  2. جرب هذا الكود Sub Print_First_Sheet_In_Selections() ''''''''''''''''Replace ".Select" By ".PrintOut" '''''''''' ActiveWindow.SelectedSheets(1).Select End Sub
  3. جرب هذا الكود Option Explicit Sub Rrint_out() Dim sh As Worksheet For Each sh In Sheets If sh.Name Like "??" & "-##*" Then 'Choose sh.PrintPreview Or sh.PrintOut sh.PrintPreview ' sh.PrintOut End If Next End Sub
  4. انا ارى ان هذا الكود عديم الفائدة لانه ما الغاية من ان نقول للاكسل "حدد لنا هذا النطاق و نكون قد حددناه مسبقا كي يتعرف عليه" فنحن قد حدناه مسبقاً الافضل ان نعطيه العنوان ونكلفه بتحديد النطاق المناسب (مع اعطاء رسالة في حال الخطأ) بواسطة هذا الكود Option Explicit Sub select_by_choise() Dim Reg As Object Dim i%, rg As Range Dim Inp_Box Inp_Box = InputBox("Type Your Range Address") Set Reg = CreateObject("VBScript.RegExp") With Reg .Pattern = _ "(^\s+?\$?[A-Z]+\$*?\d+\s*?:\s*?\$?[A-Z]+\$\d+\s*?$|^\$?[A-Z]+\$*?\d+\s*?$)" .IgnoreCase = True .Global = True End With On Error Resume Next Set rg = Range(Inp_Box) If Err.Number > 0 Then MsgBox "Wrong Address :" & Chr(10) & " " _ & """" & Inp_Box & """" Exit Sub End If Range(Inp_Box).Select End Sub الملف مرفق للتجربة Select_by_CHOISE_RG.xlsm
  5. جرب هذا الكود Sub test() Dim My_RG As Range Set My_RG = Application.InputBox("Select Your Range Please", Type:=8) Range(My_RG.Address).Select End Sub Selection_by_Choise.xlsm
  6. المعادلات باستعمال Indirect يجب ان تذكر اسم الصفحة وليس رقها الملف مرفق كنموذج KPI AIDE.xlsx
  7. ليفهم الاكسل ان التوقيت بعد الطهر وليس صباحاَ يجب كتابة الوفت هكذا pm 2:00:00 PM
  8. تم معالجة الامر الصفحة Salim من هذا الملف Order_Lycee_1 - Copy.xlsm
  9. معادلا ت ممتازة لكن في هذه الحالة لا بد من ادراج معادلة مستقلة لكل عامود من العامود (R) الى العامود (AC) بينما في اجابتي معادلة في الخلية (R6) واحدة تكفي مع سحبها يسارا 12 عامود و نزولاً 6 صفوف (بدون عامود مساعد)
  10. هذا الكود ربما يساعدك Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim a, b, c a = Not Intersect(Target, Union(Range("A2:A1000"), _ Range("D2:D1000"))) Is Nothing b = Target.Cells(1) <> vbNullString c = Target.Count = 1 Application.EnableEvents = False If a * b * c <> 0 Then Target.Offset(, 1).Select End If Application.EnableEvents = True End Sub
  11. عندما ضغطت على الزر اول مرة قام البرنامج بترتيب الصفحات واذا ضغطت مرة ثانية انت تطلب منه ان يرتبها ، لكن هي مرتبة فعلا ولذلك لا يفعل شيئاً جرب اعادة خربتتها بشكل عشوائي واضغط الزر وترى ما أقصده
  12. وهذا الكود يقوم بنفس العمل لكن مع عدد متغير من الصفوف يكفي ان تضع في الخلية I1 عدد الصفوف التي تريدا وتضغط على الزر Run مع تحديد نطاق الطباعة حسب الداتا التي حصلنا عليها Option Explicit Sub give_data_by_Y() If ActiveSheet.Name <> "data" Then Exit Sub Dim D As Worksheet, D2 As Worksheet Dim i%, x%, n%, Laste_Row%, Ro%, col%, m%, k%, last_col% Dim arr(), Tile() Dim y Set D = Sheets("data"): Set D2 = Sheets("data2") y = D.Range("i1") Laste_Row = D.Cells(Rows.Count, 1).End(3).Row D2.Cells.Clear x = (Laste_Row \ y) + 1 k = 1 ReDim arr(1 To x) For m = 1 To x arr(m) = y * (k - 1) + 3 k = k + 1 Next Ro = 3: col = 1 '++++++++++++++++++++++++++ Get The Result For k = 1 To UBound(arr) With D2.Cells(Ro, col).Resize(y) .Value = _ D.Range("A" & arr(k)).Resize(y).Value .Offset(, 1).Value = _ D.Range("B" & arr(k)).Resize(y).Value .Offset(, 2).Value = _ D.Range("G" & arr(k)).Resize(, y).Value End With D2.Cells(1, col + 3).ColumnWidth = 0.75 D2.Cells(4, col + 3).Formula = "=""""" col = col + 4 Next '++++++++++++++++++++++++++End Of The Result '__________________________Type The Titles last_col = D2.Cells(3, Columns.Count).End(1).Column Tile = Array("رقم ", "الاسم و اللقب ", "القسم") For m = 1 To last_col Step 4 D2.Cells(2, m + 3).Resize(y + 1). _ Interior.ColorIndex = 40 D2.Cells(2, m).Resize(, 3) = Tile Next '__________________________ End Of Typing The Titles '++++++++++++++++++++++++++ Format The Result With D2.Cells(2, 1).Resize(y + 1, last_col) .Borders.LineStyle = 1: .HorizontalAlignment = 1 .VerticalAlignment = 2: .Font.Size = 14 .Font.Bold = True: .InsertIndent 1 .Columns.AutoFit End With With D2.Cells(2, 1).Resize(, last_col) .HorizontalAlignment = 3 .Interior.ColorIndex = 6 End With n = Application.CountA(D2.Cells(2, last_col - 2).Resize(y)) If n < y Then D2.Cells(n + 2, last_col - 3).Resize(y - n + 1, 5).Clear End If '++++++++++++++++++++++++++ End Of The Format Of Result D2.PageSetup.PrintArea = D2.Range("A2").Resize(y + 1, last_col).Address Set D = Nothing: Set D2 = Nothing Erase arr: Erase Tile End Sub File Included New_std_salim_1.xlsm
×
×
  • اضف...