ياسر خليل أبو البراء

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

جزيت خيراً أخي الغالي رجب .. وربنا ما يحرمنا منك ولا من إبداعاتك المتواصلة تقبل وافر تقديري واحترامي

أخي الكريم الياسر جرب الكود التالي Sub Test() Dim LR As Integer LR = Cells(27, 1).End(xlUp).Row + 1 Range("A" & LR & ":F" & LR).Value = Range("A3:F3").Value End Sub تقبل تحياتي

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

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

أخي الفاضل أنس جرب التعديل التالي عله يفي بالغرض Private Sub save_pro_Click() Dim C As Range, LR As Long, I As Integer, Str As String For I = 1 To 18 If Me.Controls("CheckBox" & I).Value = True Then Str = Me.Controls("CheckBox" & I).Caption With Worksheets("4") On Error Resume Next Set C = .Rows(1).Find(What:=Str, LookAt:=xlWhole) On Error GoTo 0 If Not C Is Nothing Then LR = .Cells(Rows.Count, 1).End(xlUp).Row Intersect(.UsedRange, .Range(.Cells(C.Row, C.Column), .Cells(LR, C.Column))).Copy Worksheets("5").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) End If End With End If Next I Unload Me End Sub تقبل تحياتي

أخي الكريم عبد العزيز محمد إليك الملف المرفق لأخونا أبا الحسن والحسين فيه الطلب الأول بالنسبة للطلب الثاني توجد الأداة Frame تقوم بعمل إطار يمكنك وضع الأدوات بداخلها أرجو أن يفي الملف المرفق بالغرض Gregorian Hijri Dates UserForm.rar

أخي العزيز أنس دروبي جرب الكود التالي عله يفي بالغرض Private Sub save_pro_Click() Dim C As Range, LR As Long Dim Ctrl As Control For Each Ctrl In Me.Controls If TypeName(Ctrl) = "CheckBox" Then If Ctrl.Value = True Then With Worksheets("4") On Error Resume Next Set C = .Rows(1).Find(What:=Ctrl.Caption, LookAt:=xlWhole) On Error GoTo 0 If Not C Is Nothing Then LR = .Cells(Rows.Count, 1).End(xlUp).Row Intersect(.UsedRange, .Range(.Cells(C.Row, C.Column), .Cells(LR, C.Column))).Copy Worksheets("5").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) End If End With End If End If Next Ctrl Unload Me End Sub تقبل تحياتي

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

ولكن الجملة الواحدة تحتوي على اكثر من كلمة ..كيف ستكون النتائج في هذه الحالة ؟؟؟ أقصد توجد كلمات The و world و of و investing ...كيف سيتعامل الإكسيل مع النتائج المتوقعة؟ وماذا عن بقية الأسطر الموجودة والتي تحتوي على علامات <> أو التوقيت ...؟؟

أخي الكريم حيدر 999 أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور ليعبر عن شخصكم الكريم ..يمكنك استبدال الرقم 999 بلقبك بالنسبة لطلبك : المنتدى لا يقدم برامج جاهزة لأن تصميم البرامج يستغرق وقت طويل جداً ربما شهور وربما سنوات ... قم بوضع تصور للمطلوب وابدأ في طرح الموضوعات المختلفة التي تساهم في بناء البرنامج الذي ترغبه وإن شاء الله تجد المساعدة لا تنسى أن تقوم بالإطلاع على موضوع التوجيهات في الموضوعات المثبتة في المنتدى لمعرفة التعامل بشكل أفضل مع المنتدى والوصول لأفضل الحلول في أقل وأسرع وقت ممكن تقبل تحياتي

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

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

أخي الحبيب الغالي محمد الريفي هذه المشاركة مميزة جداً بالنسبة لي وهي مقدمة لشخص مميز وعزيز على قلبي ، لأنها المشاركة رقم 8888

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

أخي الكريم محمد علي إذا أردت المساعدة عليك تسهيل الأمر على إخوانك المرفق غير معبر عن الطلب .. قم بإرفاق ملف يخص طلبك فقط واحذف أية أكواد أخرى كما قم بحذف الفورم الغير مستخدم وركز على الفورم المطلوب فقط ، لتيسير الإطلاع على الملف من قبل إخوانك .. كما أنني لم ألاحظ وجود Image على الفورم .. ما هو الفورم المطلوب العمل عليه ؟؟ أفضل إرفاق الملف مرة أخرى بعد إجراء عملية تنقيح بحيث يكون الملف يخص الطلب في الموضوع المخصص له فقط تقبل تحياتي

أخي الكريم يرجى وضع تصور للنتائج المتوقعة ..قم بضرب مثالين للتوضيح ...

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

الحمد لله أن تم المطلوب على خير أخي الحبيب محمد الزريعي بالفعل لا تقم بالإعلان عن المتغيرين det1 و det2 من النوع تاريخ فقد ذكرت لك أنه تم تحويلهما ليكونا كرقم متسلسل وليس تاريخ .. يفضل الإعلان عنهما من النوع Variant عموماً الحمد لله أن عرفت موضع المشكلة وتم حلها بفضل الله وحده تقبل تحياتي

إليك أخي الكريم فيديو مبسط لما قدمه أخونا الحبيب أحمد Watch.rar

أخي الكريم ابن الملك المتغير MyAr عبارة عن مصفوفة ثنائية الأبعاد ..تم تحديد أبعاد المصفوفة في السطر التالي ReDim Preserve MyAr(1 To ContColmn, 1 To ii) بعد اسم المتغير وما بين الأقواس هي أبعاد المصفوفة .. البعد الأول ثم فاصلة ثم البعد الثاني وتعتمد على المتغيرات ContColmn و iii ...

جرب الكود بهذا الشكل ركز على تحويل التاريخ إلى تسلسل رقمي وليس تاريخ Sub SUMIFS_VBA() Set shName = Sheets("2") LRSH = (shName.Cells(Rows.Count, 15).End(3).Row) det1 = CDbl(#1/1/2016#) det2 = CDbl(Date) stafe = InputBox("ادخل اسم المسوق الذي هو في العمود o ") S = Application.WorksheetFunction.SumIfs( _ shName.Range("B3:B" & LRSH), _ shName.Range("P3:P" & LRSH), ">=" & det1, _ shName.Range("P3:P" & LRSH), "<=" & det2, _ shName.Range("O3:O" & LRSH), stafe) MsgBox (S) End Sub تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته أخي وحبيبي في الله عبد العزيز البسكري الفضل لله عزوجل أولاً وأخيراً فيما وصلنا إليه جمعياً ..ثم إن الفضل في هذا الموضوع لك لا ينكر الفضل إلا جاحد أو متكبر (حاشا لله أن نكون من أيٍ منهما) فقط أردت التأكيد على أن الموضوع يخصك في المقام الأول ، حتى ينسب العمل لأهله جمعنا الله وإياك في مستقر رحمته في الملأ الأعلى تقبل وافر تقديري واحترامي

جزاكم الله خيراً أخي الحبيب رجب على هذا الحل الرائع إليك حل آخر إثراءً للموضوع ضع الكود التالي في حدث الفورم Private Sub UserForm_Initialize() Dim Rng As Range Dim Dn As Range Dim Dic As Object With Sheets("Sheet1") Set Rng = .Range(.Range("C6"), .Range("C" & Rows.Count).End(xlUp)) End With Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = vbTextCompare For Each Dn In Rng: Dic(Dn.Value) = Empty: Next ComboBox1.List = Application.Transpose(Dic.keys) End Sub Private Sub ComboBox1_Click() Call cValues(ComboBox1.Value, ComboBox2, 4) '4 Is Column Number End Sub Private Sub ComboBox2_Click() Call cValues(ComboBox2.Value, ComboBox3, 5) '5 Is Column Number End Sub Sub cValues(Txt As String, Obj As Object, Col As Integer) Dim Dn As Range Dim Rng As Range Dim Dic As Object Obj.Clear With Sheets("Sheet1") Set Rng = .Range(.Cells(6, Col), .Cells(Rows.Count, Col).End(xlUp)) End With Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = 1 For Each Dn In Rng If Dn.Offset(, -1).Value = Txt Then If Not Dic.exists(Dn.Value) Then Dic(Dn.Value) = Empty End If End If Next Dn Obj.List = Application.Transpose(Dic.keys) End Sub قمت بإعادة تسمية الكومبوبوكس .. بدلاً من Sanf استخدمت الاسم الافتراضي ComboBox1 وبدلاً من Nawa استخدمت ComboBox2 والثالث جعلته بدلاً من ComboBox1 جعلته ComboBox3 .. كما قمت بإزالة الـ Row Source لأول كومبوبوكس .. تم الاستغناء عن الأكواد في حدث ورقة العمل .. فقط الكود في حدث الفورم هو الذي يقوم بالمهمة كاملة إن شاء الله أرجو أن يكون الملف مقبول لديكم تقبل تحياتي Dependent ComboBox On UserForm YasserKhalil.rar

وجب علي الاعتذار أخي الحبيب عبد العزيز البسكري .. فقد نسيت تماماً أنك صاحب الموضوع من البداية ، حيث وجد الملف في مكتبتي الخاصة ولم أذكر صاحب الملف .. فاعذرني حبيبي الغالي عبد العزيز على النسيان تقبل وافر تقديري واحترامي