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

السلام عليكم و رحمة الله اخى الكريم سوف تظهر لك رسالة تظهر اول شيت تنطبق عليه الشروط اذا ما اردت فتحه ما عليك الا الضغط على الزر "Yes" و ينتهى الماكرو اما اذا ضغطت على الزر "No" سيظهر لك الشيت التالى و هكذا حتى لآخر شيت 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 Not IsEmpty(C.Value) And x = 3 Then WsName = ws.Name OpenSht = MsgBox(" Are You Want To Open : " & WsName, vbYesNo) If OpenSht = vbYes Then ws.Activate Exit For End If End If Next End Sub

السلام عليكم ورحمة الله استخدم الكود التالى Sub ShetName() Dim ws As Worksheet Dim C As Range, WsName As String For Each ws In ThisWorkbook.Worksheets Set C = ws.Range("A1") If IsNumeric(C.Value) And Not IsEmpty(C.Value) Then WsName = WsName & Chr(10) & ws.Name End If Next MsgBox WsName End Sub

السلام عليكم ورحمة الله اجعل المعادالة فى الخلية "J5" هكذا ثم اسحبها نزولا =IF(I5="";"";RANK($I5;$I$5:$I$17)+COUNTIF(I5:$I$5;I5)-1)

السلام عليكم ورحمة الله استخدم هذا الكود Sub DistStudents() Dim ws As Worksheet, Sh As Worksheet Dim C As Range Dim p As Long Dim A As Variant, B As Variant Set ws = Sheets("قائمة") Set Sh = Sheets("تسجيل البيانات") A = ws.Range("I2") B = ws.Range("J2") x = Sh.Range("B" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ws.Range("A8:H47").ClearContents For Each C In Sh.Range("E2:E" & x) If C.Value = A And C.Offset(0, 1) = B Then p = p + 1 If p <= 40 Then ws.Cells(p + 7, 1) = p ws.Cells(p + 7, 2) = C.Offset(0, -3).Value ws.Cells(p + 7, 3) = C.Offset(0, -2).Value ws.Cells(p + 7, 4) = C.Offset(0, -1).Value ElseIf p > 40 Then ws.Cells(p - 33, 5) = p ws.Cells(p - 33, 6) = C.Offset(0, -3).Value ws.Cells(p - 33, 7) = C.Offset(0, -2).Value ws.Cells(p - 33, 8) = C.Offset(0, -1).Value End If End If Next Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله ربما تقصد هذا الشكل id 2.xlsm

السلام عليكم ورحمة الله اخى الكريم عبد الكريم ربما تقصد ان تكون المعادلة بهذا الشكل و الله اعلى و اعلم =IF(M9="";"";SUM(M9;L9))

السلام عليكم ورحمة الله ضع هذا الكود فى حدث ThisWorkBook Private Sub Workbook_Open() UserForm1.Show End Sub

السلام عليكم ورحمة الله عفوا اخى الكريم اجعل الكود بهذا الشكل يعمل معك مدى الحياة فقط يمكنك التعديل من خلال الكود الخلية تريد ظهور التاريخ فيها و الشكر موصول لاخى الرائد77 Private Sub Workbook_Open() Dim i As Integer i = Year(Date) j = Month(Date) If j < 7 Then Sheets("Sheet3").Range("A1").Value = "7 / 1 / " & i - 1 Else Sheets("Sheet3").Range("A1").Value = "7 / 1 / " & i End If End Sub

السلام عليكم ورحمة الله اجعل المعادلة هكذا ثم اضغط Ctrl+Shift+Enter ثم اسحب الى الاسفل =IFERROR(INDEX(Data!$D$2:$D$5;SMALL(IF(Data!$D$2:$D$5<>"";ROW(Data!$D$2:$D$5));ROW(A1))-1);"")

السلام عليكم ورحمة الله فى محاولة يائسة جرب هذه ="TickerChart|Live!'QO."&A2&".TAD$lasttradeprice'" ثم اسحب نزولا للصف الذى تريد

السلام عليكم ورحمة الله ربما تقصد هذا اليك الملف Classeur1.xlsx

السلام عليكم ورحمة الله استخدمى الكود التالى بدلا من الكود السابق Sub Reda20204() Dim ws As Worksheet, Sh As Worksheet Dim Lr As Long, Ls As Long Application.ScreenUpdating = False Set ws = Sheets("فاتورة_مبيعات") Set Sh = Sheets("المبيعات") Lr = WorksheetFunction.CountA(ws.Range("F16:F25")) + 15 If Lr < 16 Then Lr = 16 Else Lr = Lr End If ws.Range("B16:M" & Lr).Copy Ls = Sh.Range("B" & Rows.Count).End(xlUp).Row Sh.Range("B" & Ls + 1).Select Selection.PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox ("ابدأعملية جديدة") ws.Range("F16:I25").Value = "" ws.Range("K16:L25").Value = "" Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله اليك صورة للفورم كما يظهر عندى على الجهاز ولا ادرى لماذا تظهر عندك مخالفة

السلام عليكم ورحمة الله ابنتى العزيزة كل عام وانتى بخير اجعلى الكود هكذا Sub reda20204() Dim lr As Integer Sheets("فاتورة_مبيعات").Activate lr = WorksheetFunction.CountA(Range("F16:F25")) + 15 Range("B16:m" & lr).Copy Sheets("المبيعات").Activate Range("B7").PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox ("ابدأعملية جديدة") Sheets("فاتورة_مبيعات").Activate Sheets("فاتورة_مبيعات").Range("i24").Value = "" Sheets("فاتورة_مبيعات").Range("i16").Value = "" Sheets("فاتورة_مبيعات").Range("i17").Value = "" Sheets("فاتورة_مبيعات").Range("i18").Value = "" Sheets("فاتورة_مبيعات").Range("i19").Value = "" Sheets("فاتورة_مبيعات").Range("i20").Value = "" Sheets("فاتورة_مبيعات").Range("i21").Value = "" Sheets("فاتورة_مبيعات").Range("i22").Value = "" Sheets("فاتورة_مبيعات").Range("i23").Value = "" Sheets("فاتورة_مبيعات").Range("f24").Value = "" Sheets("فاتورة_مبيعات").Range("f25").Value = "" Sheets("فاتورة_مبيعات").Range("f16").Value = "" Sheets("فاتورة_مبيعات").Range("f17").Value = "" Sheets("فاتورة_مبيعات").Range("f18").Value = "" Sheets("فاتورة_مبيعات").Range("f19").Value = "" Sheets("فاتورة_مبيعات").Range("f20").Value = "" Sheets("فاتورة_مبيعات").Range("f21").Value = "" Sheets("فاتورة_مبيعات").Range("f22").Value = "" Sheets("فاتورة_مبيعات").Range("f23").Value = "" Sheets("فاتورة_مبيعات").Range("L24").Value = "" Sheets("فاتورة_مبيعات").Range("L25").Value = "" Sheets("فاتورة_مبيعات").Range("l16").Value = "" Sheets("فاتورة_مبيعات").Range("l17").Value = "" Sheets("فاتورة_مبيعات").Range("L18").Value = "" Sheets("فاتورة_مبيعات").Range("l19").Value = "" Sheets("فاتورة_مبيعات").Range("l20").Value = "" Sheets("فاتورة_مبيعات").Range("L21").Value = "" Sheets("فاتورة_مبيعات").Range("L22").Value = "" Sheets("فاتورة_مبيعات").Range("l23").Value = "" Sheets("فاتورة_مبيعات").Range("h24").Value = "" Sheets("فاتورة_مبيعات").Range("H25").Value = "" Sheets("فاتورة_مبيعات").Range("h16").Value = "" Sheets("فاتورة_مبيعات").Range("h17").Value = "" Sheets("فاتورة_مبيعات").Range("h18").Value = "" Sheets("فاتورة_مبيعات").Range("h19").Value = "" Sheets("فاتورة_مبيعات").Range("h20").Value = "" Sheets("فاتورة_مبيعات").Range("h21").Value = "" Sheets("فاتورة_مبيعات").Range("h22").Value = "" Sheets("فاتورة_مبيعات").Range("h23").Value = "" Sheets("فاتورة_مبيعات").Range("k25").Value = "" Sheets("فاتورة_مبيعات").Range("K24").Value = "" Sheets("فاتورة_مبيعات").Range("k16").Value = "" Sheets("فاتورة_مبيعات").Range("k17").Value = "" Sheets("فاتورة_مبيعات").Range("k18").Value = "" Sheets("فاتورة_مبيعات").Range("k19").Value = "" Sheets("فاتورة_مبيعات").Range("k20").Value = "" Sheets("فاتورة_مبيعات").Range("k21").Value = "" Sheets("فاتورة_مبيعات").Range("k22").Value = "" Sheets("فاتورة_مبيعات").Range("k23").Value = "" End Sub

السلام عليكم ورحمة الله اجعل الكود هكذا Private Sub UserForm_activate() Calendar = vbCalHijri EDate = Date Label1.Caption = Format(Date, "ddd dd mmm yyyy") & " هـ" End Sub و الله الموفق و المستعان

السلام عليكم ورحمة الله الكود للكومبو بوكس الثانى يكون هكذا Private Sub ComboBox2_Change() Label2.Caption = ComboBox2.Text & " - " & ComboBox1.Text End Sub و يتم الغاء هذه الجزئية من كود الكومبوبوكس الاول و ان شيئت يمكنك استبدال كود الكومبوبوكس الاول بهذا الكود ولك حرية الاختيار Private Sub ComboBox1_Change() Dim ws As Worksheet Dim x As Integer, y As Integer Dim Cny As String, Cty As String Label2.Caption = " " Set ws = Sheets("Sheet2") Cny = Me.ComboBox1.Value x = WorksheetFunction.Match(Cny, ws.Range("M2:Y2"), 0) + 12 y = ws.Cells(Rows.Count, x).End(xlUp).Row ws.Range(ws.Cells(3, x), ws.Cells(y, x)).Name = "Sors" Me.ComboBox2.RowSource = "Sors" End Sub و كل عام وانتم بخير

السلام عليكم ورحمة الله الاستاذ / عبد الفتاح فى بى اكسيل الاستاذ / الرائد 77 تهنئة مزدوجة بمناسبة حلول شهر رمضان المعظم اعاده علينا وعليكم وعلى الامة الاسلامية بالخير والبركات و المناسبة الاخرى لترقية الزميلين الفاضلين مع اطيب التبريكات و التهانى عن جدارة و استحقاق

السلام عليكم ورحمة الله استبدل الكود السابق فى حدث الورقة بهذا الكود لاحظ ان القائمة المنسدلة فى الملف الاخير اصبحت فى الخلية "E1" و ليس الخلية "E3" اى تغيير لخلية القائمة المنسدلة يجعل الكود لا قيمة له اليك الكود {Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$E$1" Then Exit Sub If Target.Value = "اجمالى" Then Call Code1 ElseIf Target.Value = "دراسة" Then Call Code2 ElseIf Target.Value = "بحث" Then Call Code3 ElseIf Target.Value = "صح" Then Call Code4 ElseIf Target.Value = "اظهار الفورم" Then Call aaa Else Exit Sub End If End Sub

السلام عليكم ورحمة الله الف شكر اخى الكريم عبد الفتاح على هذه الاضافة و يمكن ايضا و ضع هذا الكود فى حدث الورقة مع استخدام الكود الاول Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Call SelRange End If End Sub

السلام عليكم ورحمة الله اخى لا يمكن العمل دائما على التخمين فقد كان لابد من ارسال ملف و تعاملت معك رغم ان هذا مخالف لقواعد المنتدى اذا لم تستطغ حل المشكلة يرجى ارسال نسخة من مصغرة من الملف الاصلى لحل المشكلة هذا و الله ولى التوفيق

السلام عليكم ورحمة الله استخدم الكود التالى Sub SelRange() i = 2 Do While 1000 x = Cells(i, 1) If x = Range("A1") Then Cells(i, 1).Select Exit Do End If i = i + 1 Loop End Sub

السلام عليكم ورحمة الله الملف و به القائمة المنسدلة جاهزة قائمة منسدلة.xls

السلام عليكم ورحمة الله بفرض جعل القائمة المنسدلة قى الخلية "E3" ضع الكود التالى فى حدث الورقة و تغيير الاكواد Code1 , Cod2 .... الخ باسماء الاكواد التى لديك Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$E$3" Then Exit Sub If Target.Value = "اجمالى" Then Call Code1 ElseIf Target.Value = "دراسة" Then Call Code2 ElseIf Target.Value = "بحث" Then Call Code3 ElseIf Target.Value = "صح" Then Call Code4 Else Exit Sub End If End Sub

السلام عليكم ورحمة الله استخدم هذا الكود Private Sub CommandButton1_Click() Dim C As Range For Each C In Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row) If IsEmpty(C.Offset(0, 1)) Then C.Offset(0, 1).Value = "غ" End If Next End Sub

السلام عليكم ورحمة الله ضع هذا الكود فى حدث ThisWorkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) For i = 1 To Sheets.Count Sheets(i).Range("A1").Value = i Next End Sub