أبو حنــــين

نسيت ان اطرح سؤال هل الطباعة لها علاقة بما هو موجود في الشيت او ما هو موجود في ListBox1 Sheet1

السلام عليكم هل هناك معيار آخر مثلا طباعة فاتورة شراء فقط او بيع فقط او كليهما او تحديد اسم معين ...........

أخي عبد السلام أنعمت مساءا جزاكم الله خيرا و بارك فيكم على المرور

استعمل هذا الكود Range("A2").Resize(ListBox1.ListCount, 4).Value = ListBox1.List

Private Sub UserForm_Activate() Dim My_Array As Variant, x As Long, My_Rng As Range ReDim My_Array(1 To Application.WorksheetFunction.CountA([A:A])) For Each My_Rng In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row) x = My_Rng.Row - 1 If Not IsEmpty(My_Rng) Then My_Array(i + 1) = My_Rng.Value i = i + 1 End If Next ReDim Preserve My_Array(1 To i) ComboBox1.List = My_Array End Sub جرب هذه الطريقة : ملاحظة : البيانات التي ستدرج في الكمبوبكس مكررة و في حالة ما إذا اردنا القيم الفريدة فقط نضيف : Application.WorksheetFunction.CountA

ارسل ملف به المطلوب ليتم الشرح بصورة اوضح

استعمل هذا Range("C1") = DateDiff("d", Range("A1"), Range("B1")) '"d" ----> "m" ------> ------> "yyyy"

الحمد لله

يكون الكود بهذا الشكل Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Cells.Interior.ColorIndex = 0 Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 8)).Interior.ColorIndex = 4 End Sub

السلام عليكم حسب ما فهمت أنك تريد جلب بيانات من ملفات حسب أسمائها جرب المرفق File 2.rar

جزيت خيرا أخي بارك الله فيكم

السلام عليكم كما ذكر أخي ياسر من الأحسن إرسال ملف ، لكن الاختصار ربما طريقه تكون باستعمال : Select Case و كمثال لبداية الكود : Sub GGG() lastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1 For s = 1 To lastRow If UserForm1.TextBox1.Text = Sheet2.Cells(s, 1).Text Then If Sheet2.Cells(s, 21).Value = "" Then t = 0 Select Case Sheet2.Cells(s, 10 + t).Value Case Is = "A": Sheet2.Cells(s, 10 + t).Value = 4 Case Is = "A-": Sheet2.Cells(s, 10 + t).Value = 3.7 Case Is = "B": Sheet2.Cells(s, 10 + t).Value = 3 Case Is = "B+": Sheet2.Cells(s, 10 + t).Value = 3.3 '-............... '-............... '-............... '-............... '-............... '-............... End If End Select Next '-............... '-............... '-............... '-............... '-............... '-............... End Sub

السلام عليكم أخي من الأحسن إرسال ملف توضح فيه المطلوب بإدراج نتائج متوقعة لكي يتفاعل الإخوة مع طلبكم

بالفعل أخي ياسر و لقد اطلعت للتو على ردك و اعتقد جازما انه هو الرد المناسب التسرع في بعض الأحيان يورط صاحبه تحياتي ... جزاك الله خيرا

Private Sub Workbook_Open() Dim sh As Worksheet, M As Byte Set sh = Sheets("sData") With sh On Error GoTo 1 M = Format(Date, "m") .Columns("C:N").Hidden = False .Range(Cells(1, 3), Cells(1, Val(M) + 1)).EntireColumn.Hidden = True 1 End With End Sub جرب هذا الكود

فكرة جميلة و هذا هو التطبيق عليها المضـــخات 2.rar

السلام عليكم اخي كريم التنسيق الشرطي وضعته فقط في الخانة C9 و الخانة B9 لتتلون القيم بالاحمر و الاخضر اما عن الاسهم فهي تتغير من الاحمر الى الاخضر او بالعكس عن طريق كود موجود في الصفحة و هذا نصه : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Val(Range("C9").Value) > Val(Range("B9").Value) Then Me.Shapes("Flech2").Visible = msoFalse Me.Shapes("Flech1").Visible = msoCTrue Else Me.Shapes("Flech2").Visible = msoCTrue Me.Shapes("Flech1").Visible = msoFalse End If End Sub و كما ذكر اخي محي الدين توجد طريقة تغيير لون السهم بالتنسيق الشرطي لكنني لم اجربها في تغيير السهم جربتها في تغيير التاريخ فقط

السلام عليكم اترك لنا بعض الوقت لنقوم بالعمل او ارسلي بريدك الالكتروني على الرسائل الخاصة و حينما أنهي العمل سارسله لك عبر البريد الالكتروني

هذه بعض خصائص الخطوط

تمت و الحمد لله

السلام عليكم جرب هذا الملف المضـــخات.rar

السلام عليكم كلما تمت التجربة كلما قلت الاخطاء بالفعل لم اضع الاجمالي في آخر صفحة الطباعة امسح الموديل 2 و انسخ مكانه الكود التالي Sub iPageSetup() Application.ScreenUpdating = False Dim sh As Worksheet, Lr As Integer, Last As Integer Set sh = Sheets("sPrint") With sh Last = .Range("A" & Rows.Count).End(xlUp).Row + 1 .PageSetup.PrintArea = "" .Range("A8:E" & Last).Borders.Value = 0 '----------------------------------------------------- .Range("A8:E" & Last).ClearContents '------------------------------------------------------- .PageSetup.LeftMargin = Application.InchesToPoints(0.5) .PageSetup.RightMargin = Application.InchesToPoints(0.5) .PageSetup.TopMargin = Application.InchesToPoints(0.5) .PageSetup.BottomMargin = Application.InchesToPoints(0.5) .Columns("A:A").ColumnWidth = 8: .Columns("B:B").ColumnWidth = 18 .Columns("C:C").ColumnWidth = 25: .Columns("D:D").ColumnWidth = 14 .Columns("E:E").ColumnWidth = 15: .Cells.Font.Size = 12 End With sh.Range("A8").Resize(UserForm2.ListBox1.ListCount, 5).Value = UserForm2.ListBox1.List Lr = sh.Range("A" & Rows.Count).End(xlUp).Row sh.Range("A8:E" & Lr).Borders.Value = 1 sh.Range("C" & Lr + 2) = "المجمــوع :" sh.Range("D" & Lr + 2) = UserForm2.T_Total.Value sh.Range("C" & Lr + 2 & ":D" & Lr + 2).Borders.Value = 1 sh.PageSetup.PrintArea = "A1:E" & Lr + 3 Application.ScreenUpdating = True sh.PrintOut End Sub

السلام عليكم هذه محاولة لا ادري عل تفيد او لا الطريقة المثالية للتنقل بين الخلايا 33.rar

مرحبا أخي مهند ما هي المشكلة في المجموع بالتفصيل لكي اقوم بعلاجها

السلام عليكم أخي ياسر العربي جزاكم الله خيرا على المرور و انعم عليكم بالصحة و الهناء سعدت كثيرا حينما رأيت بصمتكم هنا أخي وائل يونس ياراجل . . . . إنت بس إضمنلي أكلة وحدة من القائمة المنسدلة للاطعمة التي ذكرتها و رمشة عين تلاقيني في مطار دمشق ( في الطيارة طوالي ) و يا عيني على المشوي و ما جاوره و راح اطبق عليها الكود التالي : IF المشوي و الكباب في سوريا then راح اطير إليها طوالي Else ارجع لبيتي مكسور الخاطر End if أخي وائل : و الله لقد سعت كثيرا لمرحك و طيبة قلبك ، جزاكم الله خيرا