نجوم المشاركات

السلام عليكم الاخ الكريم / أبو چيداء بارك الله فيك لتنفيذ طلبك الاخير استخدم الكود التالي فمثلا ان اردت دمج الخليتين (A2 و B2 ) وكذلك تغيير ارتفاع الصف الثاني نستخدم الكود التالي Sub sama1() Range("A2:B2").Merge Rows("2:2").RowHeight = 27 End Sub حيث ان Range("A2:B2") هو النطاق التي تريد دمجه والسطر الثاني Rows("2:2") هو رقم الصف الذي تريده ويمكنك اخي الكريم بطريقة بسيطة وسهله الحصول علي مثل هذه الاوامر بطريقة تسجيل الماكرو ليمكنك ذلك بنفسك ليس لأي شئ الا لأن تتوصل لذلك بنفسك ومعك دائما باذن الله تقبل خالص تحياتي

الاخ الكريم بالمسبة لطلبك اليك المرفق التالي ... بالاضافة الي مرفق آخر يؤدي نفس الغرض بشكل آخر ارجو ان يفي بطلبك ninos06-ssss.rar التنقل بين الصفحات.rar

سيم وضع الجزء التالي من الكود في حدث الكومبوبكس Private Sub ComboBox1_Change() بالاضافة للموجود ElseIf Me.ComboBox1.Value = "جدول4" Then Label1.Caption = Sheet1.Cells(2, 28): Label2.Caption = Sheet1.Cells(2, 29) Label3.Caption = Sheet1.Cells(2, 30): Label4.Caption = Sheet1.Cells(2, 31) Label5.Caption = Sheet1.Cells(2, 32): Label6.Caption = Sheet1.Cells(2, 33) Label7.Caption = Sheet1.Cells(2, 34): Label8.Caption = Sheet1.Cells(2, 35) Label9.Caption = Sheet1.Cells(2, 36): hhhh وبالتالي سيتم وضع كود آخر للبحث عن البيانات لظهورها في الليست والتي تخص الجدول 4 بالاكواد المستخدمة من الاخ الفاضل / ابراهيم ابو ليله ... جزاه الله خير ا وهذا هو الجزء المقصود Sub hhhh() Dim Ary() Dim i As Integer, ii As Integer, Lr As Integer ListBox1.ColumnCount = cont With Sheet1 Lr = .Cells(.Rows.Count, "a").End(xlUp).Row For i = 3 To Lr ii = ii + 1 ReDim Preserve Ary(1 To cont, 1 To ii) Ary(1, ii) = .Cells(i, 28).Value Ary(2, ii) = .Cells(i, 29).Value Ary(3, ii) = .Cells(i, 30).Value Ary(4, ii) = .Cells(i, 31).Value Ary(5, ii) = .Cells(i, 32).Value Ary(6, ii) = .Cells(i, 33).Value Ary(7, ii) = .Cells(i, 34).Value Ary(8, ii) = .Cells(i, 35).Value Ary(9, ii) = .Cells(i, 36).Value Next End With Me.ListBox1.Column = Ary Erase Ary End Sub ارجو ان يفي ذلك بطلبك تقبل خالص تحياتي label-SSSS++.rar

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

السلام عليكم الاخ الكريم / الجموعي بارك الله فيك هل تقصد هكذا ... طريقة سهلة وبسيطة label-SSSS.rar

الاستاذ القدير العلامه الخبير / عبدالله باقشير انت بحق

السلام عليكم الاخ الكريم / ابو جيداء استخدم الكود التالي لتنفيذ طلبك ان شاء الله Sub sama() With Range("A2") .Interior.ColorIndex = 46 .Font.Name = "Arial" .Font.Size = 12 .Font.Bold = True End With End Sub تقبل خالص تحياتي

أخي العزيز / amm830133 بالنسبة لعملية التثبيت تستعمل علامة الدولار( $) لذلك فمثلا لو أرد تثبيت النطاق بشكل عام نضع علامة الدولار وذلك بالضغط على (SHIFT+4) قبل اسم العمود وقبل رقم الصف بهذا الشكل : $A$1:$C$4827 وإن أردت تثبيت الصف دون العمود ضعها قبل الرقم فقط بهذا الشكل : A$1:C$4827 وإن أردت تثبيت العمود دون الصف ضعها قبل العمود فقط بهذا الشكل $A1:$C4827 كما يمكنك تثبيت بداية النطاق دون نهايته أو العكس بهذا الشكل : $A$1:C4827 وهو ما يسمى بالمرجع النسبي أوالمطلق يتم اختيار المرجع حسب الحاجة كما يمكنك تحديد النطاق والضغط على (F4 ) لوضع علامة الدولار بشكل تلقائي وكذلك بالضغط مرة أخرى يتم التغير في الوضعيات أو إلغائها كليا تقبل تحياتي

بعد اذن أستاذى الحبيب أختى الفاضلة / سما محمد يكون التعديل فى الكود كالآتى Private Sub CommandButton1_Click() Dim Cntl As Control Dim Txt As String For Each Cntl In Me.Controls If TypeOf Cntl Is MSForms.CheckBox Then If Cntl.Value = True Then Txt = Txt & IIf(Len(Txt), " - ", "") & Cntl.Caption End If End If Next Range("B2").Value = Txt End Sub وبالنسبة للفورم يتم ازالة الـ FRAME1 التشيك بوكس.rar

نعم ممكن مع تعديل بسيط Private Sub CommandButton1_Click() Dim Cntl As Control Dim Txt As String For Each Cntl In Me.Controls If TypeOf Cntl Is MSForms.CheckBox Then If Cntl.Value = True Then Txt = Txt & IIf(Len(Txt), " - ", "") & Cntl.Caption End If End If Next Range("B2").Value = Txt End Sub تحياتي

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

السلام عليكم ورحمة الله وبركاته قائمة Validation مختارة من نتيجة بحث في نفس خلية القائمة لا تحتاج الى ترتيب بيانات البحث وممكن استخدامها في اي ورقة من اوراق الملف المرفق 2003 بحث في خلايا قائمة التحقق من الصحة.rar

أرجو من السادةالخبراء المساعدة في عمل جدول مراقبات للكلية التي أعمل بها بحثت كثير في المنتدى عن جدول مراقبات يتناسب مع الطريقة التي أستخدمها حيث ان كل المراقبات لمدراس وهي تختلف عن المراقبات في الجامعات المهم وجدت جدول للأخ عادل جلال وهو مناسب تماماً لعملي ( بالمرفقات ) اقتبست ما أريده منه والمطلوب فيه: 1- عند إضافة عدد الملاحظين لكل مادة يتم إدراجهم في الجدول مع مراعاة علامة الصح الموجودة في بعض المواد حيث تم إزالة علامة الصح لبعض الملاحظين لعدم قدرتهم على المراقبه في هذه المادة 2- أن يحاول دائماً المعادلة مابين أعداد الملاحظين بحيث يكون في نهاية الإمتحانات بعد وضع كل الجدول الأعداد تكون متساوية بقدر الإمكان مع ملاحظة بإفتراض ان إحدى الملاحظين يعاني من ظروف تمنعه من الملاحظة في الإمتحانات إلا 3 مواد فقط الأولى ( مثلا) فيضاف له 3 مواد فقط . جدول مراقبات.rar

الملف المرفق جمعت فية الحل بالاربع طرق لاخوانى الاحباء : الاستاذ / رجب جاويش الاستاذ / محمد أبو البراء الاستاذ / عبد الله باقشير الاستاذ / جمال عبد السميع وبذلك يكون الموضوع تمت الاجابة علية 4 مرات توزيع الارقام بعمود واحد على عمودين ( حسب الصفوف الزوجية و الفردية).rar

نعم بهذا الشكل ولكن ينقصه السطر الاول كالتالي LR3 = Cells(Rows.Count, "AB").End(xlUp).Row If Me.ComboBox1.Value = "جدول4" Then For RR = 1 To 9 Sheet1.Cells(LR2, RR).Offset(0, 27) = Me.Controls("TEXTBOX" & RR) Next End If والسطر هو ... لتحديد عمود بداية الجدول المقصود LR3 = Cells(Rows.Count, "AB").End(xlUp).Row

أساتذتى الأفاضل ماشاء الله تبارك الله حلول وأفكار رائعة بارك الله فى كل الأساتذة بصراحة نفسى أشارك هذه الكوكبة بفكرة أرجو أن تكون فى نفس مستوى هذه الأعمال الرائعة أولا- هذه معادلة توضع لفصل الخلايا الفردية =INDEX(C:C;(ROWS($1:1)-1)*2+2) وهذه لفصل الخلايا الزوجية: =INDEX(C:C;(ROWS($1:1)-1)*2+1) تقبلوا تحياتى: خلايا فردية منفصلة.rar

السلام عليكم الاستاذ العملاق / رجب جاويش بارك الله فيك مرورك وحده يكفي ليشرف اي موضوع واغلي سلام ودعوة لابنتك ( سما ) تقبل خالص تحياتي

أستاذى الحبيب / عبد الله باقشير سلمت يداك وحفظك الله لنا مبدعا

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

قواعد المشاركة فى الموقعاضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

الأخ عبدالرحمن لتشغيل الملف اتبع الخطوات الآتية : 1 افتح ملفك الذي تريد تحويل المعادلات فيه 2 الآن اذهب إلى ملف التحويل CONVERT وافتحه , ستظهر لك رسالة داخل ملفك . اضغط X (يعني أغلق الرسالة) 3 ستلاحظ أعلى الصفحة في ملفك ظهور قائمة جديدة في شريط القوائم في الأعلى اسمه ( الوظائف الإضافية ) 4 وبالضغط على (الوظائف الإضافية) تظهر عدة خيارات من ضمنها تحويل المعادلاب إلى أكواد ملاحظة قد لا يعمل الملف بشكل سليم لأنه قديم

السلام عليكم الاخ الحبيب / حمادة باشا جزاكم الله خيرا وائراءا للموضوع Option Explicit Private Sub btnadd_Click() Dim SourceFile As String Dim DestinationFile As String Const MyPicFilter = "(*.bmp;*.gif;*.jpg;*.jpeg;*.wmf;*.emf;*.dib;*.ico;*.cur)," & _ "*.bmp;*.gif;*.jpg;*.jpeg;*.wmf;*.emf;*.dib;*.ico;*.cur" On Error GoTo ErrLoad SourceFile = Application.GetOpenFilename(MyPicFilter, , , False) If SourceFile = "False" Then Exit Sub DestinationFile = ActiveWorkbook.Path & Mid(SourceFile, InStrRev(SourceFile, CStr(Application.PathSeparator))) Me.Image1.Picture = LoadPicture(SourceFile) FileCopy SourceFile, DestinationFile ErrLoad: If Err Then MsgBox "Error Number := " & Err.Number, vbCritical, "Error Image" Err.Clear Else MsgBox "تم نسخ الصورة", vbInformation End If End Sub المرفق 2010 فكرة نقل الصور2.rar

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

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

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

شكرا جزيلا أخى الحبيب / محمد أبو البراء وجزاك الله كل خير

الله ينور عليك يا استاذ / محمد ابو البراء مية مية بارك الله لك ولاخى الفاضل الاستاذ رجب وفرج الله عنكم الهم والضيق والكرب تعلمت منكم الكثير

استاذي الحبيب // رجب جاويش هتتعبنى ثنائاتك الكثيرة والكبيرة ( ابتسامة ) روحك النبيلة هي الاحسن والابدع استاذي الحبيب

السلام عليكم ورحمة الله وبركاته اخي الفاضل استاذ // محمد يوسف خذ هذا الملف _ وبعد اذن استاذي الحبيب // رجب جاويش _ لعله يفي الغرض _ بإذن الله تعالى _ ترحيل الزوجي والفردي_أبو البراء 2.rar

أخى الفاضل الأستاذ / محمد يوسف هل تقصد هكذا Sub ragab() Set Rng = Sheets("ورقة2").Range("C2:C353") Application.ScreenUpdating = False [D2:E1000].ClearContents For Each cl In Rng If cl.Row Mod 2 = 1 Then LR1 = Cells(Rows.Count, "D").End(xlUp).Row + 1 Cells(LR1, "D") = cl Else LR2 = Cells(Rows.Count, "E").End(xlUp).Row + 1 Cells(LR2, "E") = cl End If Next Application.ScreenUpdating = True End Sub الخلايا.rar

أخى الحبيب / محمد أبو البراء تسلم ايديك وجزاك الله كل خير

السلام عليكم بالنسبة للطلب الاول جرب هذا الكود Private Sub CommandButton1_Click() Dim iNx As Integer iNx = Me.Index - 1 With UserForm1 .MultiPage1.Value = iNx .Show End With End Sub تحياتي

أخى الفاضل / عبد الرحمن جرب المرفق الفرز التلقائي في ورقة محمية.rar

بالنسبة لطلب أخى ابراهيم بخصوص عدم تكرار البيانات وعدم وجود فراغات يكون الكود كالآتى Private Sub UserForm_Initialize() Dim Obj As Object, cl Set Obj = CreateObject("Scripting.Dictionary") LR = Cells(Rows.Count, 1).End(xlUp).Row Set Rng = Range("A2:A" & LR) For Each cl In Rng If Not IsEmpty(cl) And Not Obj.Exists(Trim(cl)) Then Obj.Add Trim(cl), 1 End If Next For Each Item In Obj ComboBox1.AddItem Item Next Set Obj = Nothing End Sub

أخى الحبيب ( عبد الرحمن ) شكرا على دعئك هذا ولك مثلة أضعافا مضاعفة تقبل تحيات : أخيك

اخى احمد بالنسبه لارغم الفورم على الفتح على صفحه معينه فى المالتى بيدج فيمكنك عمل ذلك عن طريق الدخول الى محرر الاكواد ثم اختيار الصفحه المطلوبه ثم غلق محرر الاكواد اما بالنسبه لطلبك الثانى الخاص بالتيكست بوكس 1 فقط قم باضافة الكود التالى الى زر ادخال البيانات TextBox1.Value = Sheet1.[G6]

اخى الجموعى تم عمل الطلوب بالنسبه لترحيل البيانات ---------------------------------------- اما بالنسبه ل الليبول فانا مش عارف ايه المطلوب بالظبط ممكن توضح اكتر label.rar

الاخوه الافاضل الاخ رجب جاويش الاخ حماده عمر الاخ شوقى ربيع مجهود كبير وحلول متنوعه بارك الله فيكم واسمحو لى بالمشاركه Private Sub UserForm_Initialize() Dim I As Integer With Sheets("sheet1") For r = 2 To .Range("A" & .Rows.Count).End(xlUp).Row If .Range("A" & r) <> "" Then ComboBox1.AddItem .Range("A" & r) End If Next r End With End Sub

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

بعد حديث أستاذنا الرائع ( رجب جاويش ) عن القواعد المثلى للمشاركة أيضا يستحسن أستاذى ليكون طلب حضرتك أسرع وأدق فى التنفيذ من قبل الزملاء ، وراغبى المساعدة أن ترسل مرفق يحتوى على المطلوب وشكل المطلوب المرجو من الحل ولرفع المرفق على الموقع لابد أن تضغط الملف بأحد برامج الضغط على سبيل المثال ( WINRAR ) ثم قم برفعة وإن شاء الله تجد الحل سريعا تقبل تحياتى : ومرحبا بك مرة ثانية أخا كريما بين أخوتك

أخى الفاضل تكون الأكواد كالآتى Private Sub UserForm_Initialize() With ComboBox1 For i = 2 To 8 If Not IsEmpty(Cells(i, 1)) Then ComboBox1.AddItem Cells(i, 1) Next End With End Sub Private Sub UserForm_Activate() With ComboBox2 For i = 2 To 8 If Not IsEmpty(Cells(1, i)) Then ComboBox2.AddItem Cells(1, i) Next End With End Sub

أخى الفاضل / عبد الرحمن أرفق ملف به مثال لما تقول حتى يمكن التجربة عليه

السلام عليكم الاستاذ القدير العلامه الخبير / عبدالله باقشير بارك الله فيك دمت لنا معلما وقائداً عظيما فالاكسيل انت وانت الاكسيل تقبل خالص تحياتي

أخى الفاضل / المحامي خالد أولا : مرحبا بك أخى الفاضل فى منتدى أوفيسنا العريق ثانيا: يرجى اختيار عنوان مناسب للموضوع يدل على محتوى الطلب ثالثا : يرجى وضع مرفق توضح به ما تريد حتى يسهل العمل عليه رابعا: تم تغيير العنوان ولكن فضلا الاهتمام بهذه النقطة فى المرات القادمة

اخى العزيز الاستاذ // عبدالله باقشير جزاكم الله خيرا وبارك فيكم

السلام عليكم جرب الكود التالي Private Sub CommandButton1_Click() Dim Cntl As Control Dim Txt As String For Each Cntl In Me.Frame1.Controls If TypeOf Cntl Is MSForms.CheckBox Then If Cntl.Value = True Then Txt = Txt & IIf(Len(Txt), " - ", "") & Cntl.Caption End If End If Next Range("B2").Value = Txt End Sub تحياتي

أخى الفاضل / الشيباني1 جرب المرفق لعله يعجبك new_file.rar

الأستاذ / أحمد السلام عليكم ورحمة الله وبركاته الحمد لله الذي وفقني لعمل المطلوب هذا من فضل ربي وجزاك الله خيراً على دعائك الطيب ولك بمثله أضعافاً مضاعفة . أنا قسمت العمل المنجز على حسب تاريخ اليوم وحسب الفترة المسموح بها. وإليك الملف به تنسيق شرطي يبين الأداء. متقدم او متأخر 11.rar

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

الأخت الفاضلة / سما محمد وبعد اذن المهندس الفاضل / طارق محمود تم اضافة سطر واحد للكود الرائع للمهندس طارق واضافة ملفات بباقى الشهور لعله يفى بالغرض جربى المرفق البرنامج 111.rar