عبدالله باقشير

الاخ الحبيب/ رجب جاويش

السلام عليكم قبل الانتقال الى ورقة معينة اولا تظهر هذه الورقة وتنتقل اليها ثم تخفي باقي الاوراق. في هذه الحالة لن تبقى اي ورقة ظاهره غير التي انتقلت اليها او قبل الانتقال الى ورقة معينة اولا تظهر هذه الورقة وتنتقل اليها ثم تخفي الورقة التي ضغطت امر الانتقال منها في هذه الحالة تظهر ورقه وتخفي ورقة وتبقى الاوراق الاخرى مثل حالتها السابقة في امان الله

السلام عليكم تفضل هذا الكود مختصر وبسيط يقوم بما طلبت Sub invoice_in() Dim Z As Integer, Y As Integer If Sheet5.[C12] = Empty Or Sheet5.[E12] = Empty Then MsgBox " من فضلك ادخل البيانات " Exit Sub End If ''''''''''''''''''''''''''''''''''''' If MsgBox("هل تريد ادخال البيانات", vbYesNo, lifesoft) = vbNo Then Exit Sub ''''''''''''''''''''''''''''''''''''' Z = Sheet2.Range("a3500").End(xlUp).Row + 1 Y = Application.WorksheetFunction.CountA(Sheet5.[C17:C36]) ''''''''''''''''''''''''''''''''''''' Application.ScreenUpdating = False With Sheet2 .Range("A" & Z).Resize(Y, 6).Value = Array([C12], [C14], [E12], [E14], [I12], [I14]) .Range("G" & Z).Resize(Y, 9).Value = Range("B17").Resize(Y, 9).Value .Range("P" & Z).Resize(Y, 3).Value = Array([J39], [J40], [J41]) End With Application.ScreenUpdating = True ''''''''''''''''''''''''''''''''''''' End Sub في امان الله

السلام عليكم ما شاء الله عليك اخي حماده نشيط ومبدع جزاك ربي خيرا وبارك فيك تقبل تحياتي وشكري

السلام عليكم هذه دالة تعطي نتائج صفيف للارقام من 1 الى الرقم الذي تحدده في الدالة في المتغير ContGrob لتعديل الدالة: حدد الخلايا من اول صف لوضع الدالة الى آخر صف لوضع الدالة . اضغط F2 لتحرير الدالة ثم اضغط CTRL+SHIFT+ENTER مع ملاحظة ان تكون عدد الصفوف الموضوعه فيها الدالة تساوي العدد في المتغير ContGrob للدالة. وايضا لاتقبل التعديل لجزء منها ووللخروج من هذه الحالة استخدم الزر ESC Function kh_RndGrob(ByVal ContGrob As Integer, Optional t As Double) Dim obj Dim iRnd As Integer, i As Integer '======================================== Set obj = CreateObject("Scripting.Dictionary") '======================================== Do iRnd = Int(Rnd * ContGrob) + 1 If Not obj.Exists(iRnd) Then i = i + 1 obj.Add iRnd, i End If If i = ContGrob Then Exit Do Loop kh_RndGrob = WorksheetFunction.Transpose(obj.keys) Set obj = Nothing End Function المرفق 2003ه RandomNumbers.rar

وعليكم السلام ورحمة الله وبركاته نورت المنتدى وحمد لله على السلامة اسعدني مرورك جزاك الله خيرا تقبل تحياتي وشكري

السلام عليكم جزاك الله خيرا وبارك فيك فعلا رابط مهم تقبل تحياتي وشكري

السلام عليكم جرب هذا الكود: Sub kh_Sum() Dim objlist Dim r As Integer, i As Integer Dim MyKey As String Dim zz() As String Set objlist = CreateObject("Scripting.Dictionary") ''''''''''''''''''''''''''''' With ورقة2 .Range("B2:D1000").ClearContents For r = 2 To 1000 MyKey = CStr(.Cells(r, "A")) If MyKey <> "0" Then If Not objlist.Exists(MyKey) Then i = i + 1 objlist.Add MyKey, i ReDim Preserve zz(1 To 2, 1 To i) zz(1, i) = MyKey zz(2, i) = WorksheetFunction.CountIf(.Range("A2:A1000"), MyKey) End If End If Next End With ''''''''''''''''''''''''''''' If i Then With ورقة2 .Range("B2").Resize(i, 2).Value = WorksheetFunction.Transpose(zz) End With End If ''''''''''''''''''''''''''''' Set objlist = Nothing Erase zz End Sub المرفق2003 CAR Control1.rar

السلام عليكم اخي الحبيب ابو خليل ----حفظك ربي جمعة مباركة Sub KH_SET() Dim Rng As Range With ActiveSheet Set Rng = Union(.Range("A12:A" & .Rows.Count), .Range("E12:E" & .Rows.Count)) End With End Sub في امان الله

السلام عليكم يمكنك تغيير عدد صفوف الجدول في الثابت ContRow ولم تذكر هل تريد صف عناوين الاعمدة يتكرر في الجداول الكود: ' عدد صفوف الجدول Const ContRow As Integer = 28 ' اول صف للبيانات Const iRow As Integer = 2 Sub kh_Start() Dim i As Long, ii As Long, iii As Long Dim LastRow As Long ''''''''''''''''''''''' With Sheet3 .Cells.Clear Range("A1:G1").Copy .Range("A1") End With ''''''''''''''''''''''' LastRow = Range("B" & Rows.Count).End(xlUp).Row ii = 2 For i = iRow To LastRow Step ContRow If i <> iRow Then GoSub kh_Sum Range("A" & i).Resize(ContRow, 7).Copy Sheet3.Range("A" & ii) ii = ii + ContRow + 1 Next ''''''''''''''''''''''' Exit Sub ''''''''''''''''''''''' kh_Sum: With Sheet3.Range("A" & ii - 1) .Range("A1:G1").Style = "total" .Range("C1").Value = "الاجمالي" .Range("E1:G1").Formula = "=SUM(R[-" & ContRow & "]C:R[-1]C)" End With Return ''''''''''''''''''''''' End Sub المرفق 2003 الاسماء.rar

السلام عليكم جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

الاخ الكريم / حماده ------ حفظك الله يسعدني وجود مشاركتك بجانب مشاركتي سابق للخير ات بدون تردد تقبل تحياتي وشكري

شاهد الصورة من القائمة الاخيرة المسماه: اتجاه النص اختار اليمين لليسار

السلام عليكم من تنسيق الخلايا اختار من قائمة اتجاه النص اليمين لليسار في امان الله

السلام عليكم جزاك الله خيرا وانا لي الشرف استدراك: استبدل هذا بالكود المثيل السابق Private Sub UserForm_Terminate() Range("a2:b21").ClearContents If Me.ListBox1.ListIndex = -1 Then GoTo 1 With Me.ListBox1 Range("a2").Resize(.ListCount, 1).Value = .List End With 1: If Me.ListBox2.ListIndex = -1 Then GoTo 2 With Me.ListBox2 Range("b2").Resize(.ListCount, 1).Value = .List End With 2: End Sub

السلام عليكم شاهد المرفق 2003 help.rar في امان الله

السلام عليكم اعتقد ان اول اوفيس تعمل عليه وتعرف امكانيات الاكسل من خلاله يصبح المفضل عندك ... واكيد ان اي اوفيس جديد حيكون افضل في الامكانيات من السابق ..... اما عن مظهر الاوفيس فهذه اذواق ... -------------------- انا اعمل دائما وابدا على اوفيس 2003 -------------------- ملاحظة: ولو كنت من مطوري الاكسل سابقي على اي امكانية قديمة واطورها الى الاحسن واتجنب الغائها !!!!!!!!!!!!!! وذلك لكي تعمل هذه الامكانية في جميع الاصدارات الجديدة في امان الله

جزاك الله خيرا اخي حماده وحفظك من كل مكروه نعم ممكن يعمل على اي ورقة في اي ملف ولكن في نطاق اعمدة معين (محدد مسبقا في كود الفورم) في امان الله

السلام عليكم ملف الفورم هو :myform.xlam كلمة السر لمحرر الاكواد 1 افتح هذا الملف سيظهر لك من ضمن قوائم الاكسل MenuBars في قائمة الوظائف الاضافيه زر لفتح الفورم من اي ملف يتم فتحه فيما بعد يمكنك من فتح الفورم و التعدييل على الورقة النشطه في الملف النشط هذا على السريع في امان الله المرفق 2007 myform.rar

و عليكم السلام ورحمة الله جزاك الله خيرا بالنسبة لسؤالك: نسخ الدالة ليس اجراء صحيح مع دالة تعطي نتائج صفيف قم بالتالي : حدد الخلايا من اول صف لوضع الدالة الى آخر صف تريد وضع نتائج الدالة فيها . اضغط F2 ثم اضغط CTRL+SHIFT+ENTER مع ملاحظة ان تكون عدد الصفوف الموضوعه فيها الدالة اصغر او تساوي عدد صفوف النطاق المستخدم في الدالة في امان الله

وعليكم السلام ورحمة الله وبركاته وجزاك الله خيرا تقبل تحياتي وشكري

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

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

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