عبد الرحمن الحمصي

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

up

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

السلام عليكم الطلب في المرفقات فرز مطابق.rar

أخي بن عليه لدي تسائل صغير اذا كان ذلك ممكنا هل يمكن أن يتم تفعيل الكومبو بوكس ب ( double click ) اي بعد ضغطتين بالماوس بدلا من ضغطة واحدة و ذلك لتجنب التعديل الغير متعمد اليك الكود مرة أخرى Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Dim str As String Dim i As Integer Dim rngDV As Range Dim rng As Range Dim strMsg As String Dim lRsp As Long strMsg = "Add this item to the list?" If Target.Count > 1 Then Exit Sub Set ws = Worksheets("Data Entry") If Target.Row > 1 Then On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) On Error GoTo 0 If rngDV Is Nothing Then Exit Sub If Intersect(Target, rngDV) Is Nothing Then Exit Sub If Target = "" Then Exit Sub str = Target.Validation.Formula1 str = Right(str, Len(str) - 1) On Error Resume Next Set rng = ws.Range(str) On Error GoTo 0 If rng Is Nothing Then Exit Sub If Application.WorksheetFunction _ .CountIf(rng, Target.Value) Then Exit Sub Else lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?") If lRsp = vbYes Then i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 ws.Cells(i, rng.Column).Value = Target.Value rng.Sort Key1:=ws.Cells(1, rng.Column), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End If End If End Sub ' Developed by Contextures Inc. ' www.contextures.com Private Sub TempCombo_KeyDown(ByVal _ KeyCode As MSForms.ReturnInteger, _ ByVal Shift As Integer) On Error Resume Next Dim ws As Worksheet Dim str As String Dim i As Integer Dim rngDV As Range Dim rng As Range Dim strMsg As String Dim lRsp As Long Dim c As Range strMsg = "Add this item to the list?" Set ws = Worksheets("Data Entry") Set c = ActiveCell str = c.Validation.Formula1 str = Right(str, Len(str) - 1) On Error Resume Next Set rng = ws.Range(str) On Error GoTo 0 If rng Is Nothing Then Exit Sub 'Hide combo box and move to next cell on Enter and Tab Select Case KeyCode Case 9 c.Offset(0, 1).Activate If c.Value = "" Then Exit Sub If Application.WorksheetFunction _ .CountIf(rng, c.Value) Then Exit Sub Else lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?") If lRsp = vbYes Then i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 ws.Cells(i, rng.Column).Value = c.Value rng.Sort Key1:=ws.Cells(1, rng.Column), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End If Case 13 c.Offset(1, 0).Activate If c.Value = "" Then Exit Sub If Application.WorksheetFunction _ .CountIf(rng, c.Value) Then Exit Sub Else lRsp = MsgBox(strMsg, vbQuestion + vbYesNo, "Add New Item?") If lRsp = vbYes Then i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 ws.Cells(i, rng.Column).Value = c.Value rng.Sort Key1:=ws.Cells(1, rng.Column), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom End If End If Case Else 'do nothing End Select End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim str As String Dim cboTemp As OLEObject Dim ws As Worksheet Dim wsList As Worksheet Dim rng As Range Dim i As Integer Dim strMsg As String Dim lRsp As Long Set ws = ActiveSheet Set wsList = Sheets("Data Entry") Set cboTemp = ws.OLEObjects("TempCombo") strMsg = "Add this item to the list?" If Target.Count > 1 Then GoTo exitHandler On Error Resume Next With cboTemp .ListFillRange = "" .LinkedCell = "" .Visible = False End With On Error GoTo errHandler If Target.Validation.Type = 3 Then Application.EnableEvents = False str = Target.Validation.Formula1 str = Right(str, Len(str) - 1) With cboTemp .Visible = True .Left = Target.Left .Top = Target.Top .Width = Target.Width + 15 .Height = Target.Height + 3 .ListFillRange = str .LinkedCell = Target.Address End With cboTemp.Activate End If exitHandler: Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub errHandler: Resume exitHandler End Sub سامحنا على الإزعاج شكرا جزيلا

تفضلوا أخوتي الملف جاهز أتمنى ان ينال اعجابكم و تستفيدو منه كما تفيدونا دائما لكم كل الشكر و التقدير sort tables vba.rar

اخوتي حصلت على هذا الكود ولكن هل من احد من الأخوه يشرح لنا ما هي القيم التي يجب التعديل عليها في هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) ActiveWorkbook.Worksheets("Project 2013").ListObjects("Table3").sort.SortFields _ .Clear ActiveWorkbook.Worksheets("Project 2013").ListObjects("Table3").sort.SortFields _ .Add Key:=Range("Table3[Description3]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Project 2013").ListObjects("Table3").sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub بانتظار الخبراء

الحمد لله

اخوتي في الله السلام عليكم لدي هذا الكود الخفيف و الجميل يقوم بعمل فرز تلقائي sort لكل البيانات الموجودة في ورقة عمل معينة ولكن للأسف لا يدعم وجود الجداول في الورقة اي عند اضافة جدول ديناميكي لا يستطيع عمل sort لهذا الجدول ويظهر اشارة خطأ هل يمكن التعديل عليه ليشمل هذه الجداول تفضلوا الكود Private Sub Worksheet_Change(ByVal Target As Range) Columns(Target.Column).Sort _ Key1:=Cells(1, Target.Column), _ Order1:=xlAscending, _ Header:=xlNo, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom End Sub أتمنى دعمكم ولكم كل التحية و التقدير

أخ حمادة باشا ماشاء الله عليك شو مبدع

اخي بن عليه سلمت يداك يا مبدع

up

up pls

السلام عليكم أرجو من أهل الخبرة ايضاح ولو بسيط لطريقة دمج الإكسل مع الأكسس وما هي البرامج المستخدمة لعمل البرنامج الموجود في المرفقات ولكم جزيل الشكر سلفا Uniform Invoice Software.rar

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

up pls

شكرا أخي عبد الله ماشاء الله مواضيعك دائما مميزة

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

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

أخي الكريم عبد الرحمن، شيء واحد لم أتناوله في شرحي السابق في الملف فيها يخص الأكواد وهو مهم، أولا اسم الشيت الوحيد الذي يجب أن يكون موجودا في ملفك الجديد هو شيت "LISTS" المشار إليه في الأكواد الخاصة بالكومبوبوكس الموضوعة في كود حدث الشيت DataEntry وثانيا (وهو الأهم) لا يجب نقل أكواد شيت DataEntry إلا بعد إدراج القوائم المنسدلة في هذا الشيت باستعمال خاصية Data Validation والتسميات الخاصة بهذه القوائم ثم وضع الأكواد في كود حدث الشيت DataEntry (أو غيره -في أي شيت يحوي قوائم منسدلة-)... والله أعلم أرجو أني وصلت إلى تقريب المفهوم... أخوك بن علية أخوتي الأفاضل شكرا لكم و لجهودكم أخي بن عليه سوف أقوم بتطبيق ما أشرت إليه و أعود إليك بالنتائج لك كل الود و التقدير

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

أخي الجموعي ننتظر ردود الأخوة الأفاضل

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

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

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