حسونة حسين

وعليكم السلام ورحمه الله وبركاته تفضل ضع هذا الكود في الفورم المسمي kh Private Sub ComboBox1_Change() Dim X, Ws As Worksheet Set Ws = ThisWorkbook.Worksheets("كشف") X = Application.Match(ComboBox1, Columns(4), 0) If Not IsError(X) Then TextBox5 = Ws.Cells(X, "Aj") TextBox6 = Ws.Cells(X, "Ak") TextBox7 = Ws.Cells(X, "AL") TextBox8 = Ws.Cells(X, "AM") TextBox9 = Ws.Cells(X, "AN") TextBox10 = Ws.Cells(X, "AO") TextBox11 = Ws.Cells(X, "AP") TextBox12 = Ws.Cells(X, "AQ") End If End Sub الطلب الثاني ماهي شكل النتائج التي تريد عرضها في الليست بوكس ؟

يتم التزويد علي حسب الاكواد التي تضعها وليس العواميد زودت 1 كود يعني ( 6 عامود ) يبقي تزود 1 في كل السطور التى اخبرتك بها زودت 2 كود يعني ( 12 عامود ) يبقي تزود 2 في كل السطور التى اخبرتك بها زودت 3 كود يعني ( 18 عامود ) يبقي تزود 3 في كل السطور التى اخبرتك بها تمام واضحه كده

هذه السطور arr = WSData.Range("A2:Q" & WSData.Cells(Rows.count, 1).End(xlUp).Row).Value ReDim Temp(1 To UBound(arr, 1) * 3, 1 To 4) For J = 0 To 2 P = P + 2 الي arr = WSData.Range("A2:AF" & WSData.Cells(Rows.count, 1).End(xlUp).Row).Value ReDim Temp(1 To UBound(arr, 1) * 5, 1 To 4) For J = 0 To 4 P = P + 4 بدل ال Q ضع اخر عامود عندك AF بدل ال * 3 ضع * 5 بدل ال For J = 0 To 2 ضع For J = 0 To 4 بدل P = P + 2 ضع P = P + 4 المصنف2.xlsm

وعليكم السلام ورحمه الله وبركاته تفضل ان شاء الله طلبك المصنف1.xlsm

وعليكم السلام ورحمة الله وبركاته اخى @MrNoon اضغط في اي مكان في هذا السطر ActiveSheet.Columns(1).Replace ChrW(8208), ChrW(45), xlPart, , , , True, False ثم اضغط زرار f5 من الكيبورد لكي يعمل الكود

ما هي اسم الصفحه

السلام عليكم ورحمه الله وبركاته وبها نبدأ اي موضوع يمكنك ذلك عن طريق كود vba كليك يمين على الصفحه (نسخة الزبون) والضغط على view code ثم نسخ هذا الكود ولصقه في حدث الشيت كما هو ولا تنسي يتم حفظ الملف بصيغه تقبل الماكرو xlsm او xlsb Private Sub Worksheet_Activate() Dim r As Range, i As Long Cells.EntireRow.Hidden = False For i = 7 To 34 If Cells(i, 2) = "" Then If r Is Nothing Then Set r = Cells(i, 2) Else Set r = Union(r, Cells(i, 2)) End If End If Next i If Not r Is Nothing Then r.EntireRow.Hidden = True End Sub

اخي احمد لتأكيد ان الملف لم يكن به مشكله في تشغيل الماكرو انما المشكله في اعدادات الماكرو لديك هذا فيديو يوضح هذا show.zip

اخى احمد الماكرو عندك غير مفعل لتفعيل الماكرو اتبع الخطوات كما بالصورة التاليه

اخى احمد حمل هذا الملف وشغله بدون اي تغيير للبيانات واخبرنا بالنتيجه هل النتائج صحيحه ام لا

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

وجزاكم مثله اخى الكريم الحمد لله الذي بنعمته تتم الصالحات

ازل علامه الصح في هذه الصورة وان شاء الله تظبط معاك

وعليكم السلام ورحمة الله وبركاته حل مشكله اللغه العربيه

وعليكم السلام ورحمة الله وبركاته اين هى صورة الخطأ الذي يظهر لك

بارك الله فيك اخى @علي بطيخ سالم ابو عبدالرحمن وجزاكم الله خيرا على دعاؤكم الطيب

اخي محمود تم فصل المشاركه فعلا في موضوع جديد كل طلب يكون في موضوع منفصل

قم بفتح موجود خاص بك وسوف تجد الاجابه ان شاء الله

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

وعليكم السلام ورحمه الله وبركاته تفضل رابط لباقي الاوامر

الشكر لله اخى الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام ورحمة الله وبركاته جرب هذا الكود بعد اضافه المراجع التاليه Microsoft OLE DB Service Component 1.0 Type Library Microsoft ActiveX Data Objects 6.0 Library Sub Test() Dim dl As MSDASC.DataLinks Dim cn As ADODB.Connection Set dl = New MSDASC.DataLinks Set cn = New ADODB.Connection Set cn = dl.PromptNew End Sub

الحمد لله الذي بنعمته تتم الصالحات

السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع لاستخدام ctrl+f استخدم هذا الامر Application.SendKeys "^f", True