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

ابراهيم الحداد

Expert
  • Content Count

    889
  • Joined

  • Last visited

  • Days Won

    4

ابراهيم الحداد last won the day on July 14

ابراهيم الحداد had the most liked content!

Community Reputation

715 Excellent

About ابراهيم الحداد

  • Rank
    Name

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    teacher
  • Location
    Aswan
  • Interests
    Excel

Recent Profile Visitors

3,870 profile views
  1. السلام عليكم ورحمة الله جرب هذا الكود Sub Add_Data() Dim ws As Worksheet, Arc As Worksheet Dim LR As Long Set ws = Sheets("hassila") Set Arc = Sheets("Archives") LR = Arc.Range("A" & Rows.Count).End(xlUp).Row ws.Range("A7:D" & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy Arc.Activate Arc.Range("A" & LR + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False ' :اذا اردت مسح البيانات من الورقة الاولى قم بازالة العلامة التى على اليسار من العبارة التالية 'ws.Range("A7:D" & ws.Range("A" & Rows.Count).End(xlUp).Row-1).ClearContents End Sub
  2. السلام عليكم ورحمة الله ربما Lab يرمز الى Label و Lab.Caption يقصد بها ان العنوان الذى سوف يظهر على Label يكون هو النص او القيمة المكتوبة فى الصف ii و العمود 3
  3. السلام عليكم ورحمة الله اجعل الكود هكذا Sub المجموع() Dim mr As Worksheet Dim LR, i, x, y, z, w, v As Long Dim WFS As Variant Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False Set WFS = WorksheetFunction Set mr = Sheets("mark") LR = mr.Range("c" & Rows.Count).End(xlUp).Row For i = 9 To LR For x = 11 To 157 Step 10 mr.Cells(i, x) = WFS.sum(mr.Cells(i, x - 2), mr.Cells(i, x - 1)) Next x For y = 14 To 157 Step 10 mr.Cells(i, y) = WFS.sum(mr.Cells(i, y - 2)
  4. السلام عليكم ورحمة الله شكرا لكلماتك الرقيقة جعل الله لك من دعاءك الطيب نصيبا ووفقنا لما يحب و يرضى
  5. السلام عليكم ورحمة الله جرب هذا الملف للامانة العلمية توجد ورقة مخفية بالملف للتمكن من تحقيق الهدف المبيعات.xlsm
  6. السلام عليكم ورحمة الله اخى الكريم معاذ بارك الله فيك بصراحة العبقرية الحقيقية فى هذا الرد الجميل منك لقد اخجلتم تواضعنا
  7. السلام عليكم ورحمة الله بورك فيك اخى الكريم محمد جعل الله لك من دعاءك لى نصيبا و زيادة ان شاء الله
  8. السلام عليكم ورحمة الله اجعل الكود هكذا Private Sub CommandButton1_Click() UserForm1.TextBox1 = "" Dim ChekCapn As String, Data As String Dim ChekBx As Control, FData As String For Each ChekBx In Me.Controls If TypeName(ChekBx) = "CheckBox" Then ChekCapn = ChekBx.Caption If ChekBx.Value = True Then Data = Data & "," & ChekCapn FData = Mid(Data, 2, Len(Data) - 1) End If End If Next UserForm1.TextBox1.Value = FData Unload Me End Sub
  9. السلام عليكم ورحمة الله نعم اخى الكريم يمكنك اضافة عشرات الشيك بوكس الاخرى
  10. السلام عليكم ورحمة الله انظر الى هذا الملف ربما يكون هذا مطلبك ملف توضيح.xlsm
  11. السلام عليكم ورحمة الله استخدم هذا الكود فى اليوزرفورم الثانى Private Sub CommandButton1_Click() UserForm1.TextBox1 = "" Dim ChekCapn As String, Data As String Dim ChekBx As Control For Each ChekBx In Me.Controls If TypeName(ChekBx) = "CheckBox" Then ChekCapn = ChekBx.Caption If ChekBx.Value = True Then Data = Data & "," & ChekCapn End If End If Next UserForm1.TextBox1.Value = Data Unload Me End Sub
  12. السلام عليكم ورحمة الله البقاء لله انا لله و انا اليه راجعون
  13. السلام عليكم ورحمة الله استخدم هذا الكود Sub AnalysesData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long, j As Long, p As Long Dim Arr, Data As String Set ws = Sheets("ورقة1") Set Sh = Sheets("ورقة2") Sh.Range("B5").Resize(100, 6).ClearContents LR = ws.Range("D" & Rows.Count).End(xlUp).Row Data = Sh.Range("B2") Arr = ws.Range("B3:G" & LR).Value ReDim Preserve Arr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 4) = Data Then p = p + 1 For j = 1 To UBound(Arr, 2) Arr(p, j) = Arr(i, j) Next End If Next If p > 0 Then Sh.Range("
  14. السلام عليكم ورحمة الله جربى هذا الكود Sub ImportData() Dim ws As Worksheet, Sh As Worksheet Dim p As Integer, x As Integer, LR As Long Dim C As Range, A, B Application.ScreenUpdating = False Set Sh = Sheets("DataReport") A = Sh.Range("K2"): B = Sh.Range("L2"): p = 1 LR = Sh.Range("B" & Rows.Count).End(xlUp).Row For Each ws In ThisWorkbook.Worksheets x = ws.Tab.ColorIndex If x = 10 Then For Each C In ws.Range("A6:A" & ws.Range("A" & Rows.Count).End(xlUp).Row) If C >= B And C <= A Then p = p + 1 Sh.Range(Sh.Cells(p, 2), Sh.Cells(p, 9)).Value = ws.Range(ws.Cells(C.Row,
  15. السلام عليكم ورحمة الله تفضل Sub ShetName() Dim ws As Worksheet, x As Variant Dim C As Range, WsName As String Dim OpenSht As String For Each ws In ThisWorkbook.Worksheets x = ws.Tab.ColorIndex Set C = ws.Range("A1") If IsNumeric(C.Value) And C.Value > 0 And x = 3 Then WsName = ws.Name & Chr(10) & "Cells Is Value = " & C.Value OpenSht = MsgBox(" Are You Want To Open : " & WsName, vbYesNo) If OpenSht = vbYes Then ws.Activate Exit For End If End If Next End Sub
×
×
  • Create New...