ahmedghandour

' لازم تعلن عن المتغير if me.textbox1.value="" _ and me.textbox2.value="" _ and me.textbox3.value="" _ ' و هكذا حتي تنتهي من ال 18 تكست بوكس and me.textbox .value="" then msgbox " الخلايا فارغه بالفعل " ,vbokonly,"GHANDOUR" else ' اف الموجوده بالاعلي exit sub end if ' بعد عمل الامر الخاص بال

ممكن تضيف الامر التالي قبل كود التفريغ

الاخ :رشوان احمد تحياتي بعض الازرار لا اعلم مغذي عملها مثلا مفتاح حذف نهائي تقصد حذف البيانات من التيكستات بوكس ولا من خلايا الاكسل برجاء التوضيح لاكن علي كل مفتاح خروج الفرم ضع فيه الامر التالي unload me اما مفتاح الحفظ ضع فيه الكود التالي thisworkbook.save اما خروج الفورم و الاكسل (اقصد المصنف ) ضع فيه الكود التالي thisworkbook.save unload me application.quite application.displayalerts=false الامر السابق لو انت مش عاوز البرنامج طلب تاكيد علي الحفظ لانه حفظ تلقائي بمجرد الضغط علي المفتاح و كمان دا امر خاص بالمهمه دي بس يعني لو قفلت المصنف من غير الفورم هيطلب تاكيد علي الحفظ مسح البيانات دا لو من التكستات بوكس بس يبقي هتعمل الامر دا dim aa as integer if msgbox(" هل تريد تفريغ الخلايا من علي الفورم ",vbyesno,"GHANDOUR")=vbyes then for aa = 1 to 18 ' الارقام 1 الي 18 تمثل التكست بوكس عندك me.controls("TextBox" & aa).value="" next exit sub else exit sub end if بقي لديك مفتاح واحد برجاء توضيح المطلوب مع خالص تحياتي

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

عملت حيله بسيطه عشان تتخطي الخطاء الناتج عن تنسيق التاريخ لاكن بقيت مشكله و هي ان انا اعتمدت علي الشيت في خليه معينه و عطيتها الداله TODAY() و التنسيق عام هل في اليوم التالي سوف تحافظ علي التنسيق لا اعلم الموضوع محتاج بحث لاكن راجع الملف لعل تجد ما يجبر خاطرك و تقبل تحياتي appo.rar

هيا فعلا الاول خليه في الاكسل و لا اكتف اكس علي العموم تضغط كليك يمين علي الخليه و تختار تنسيق و تحتار تبويب عام و تختار الوقت من علي اليمين لو الاكسل عندك English اضغط علي الخليه كليك يمين format cells > Time >

اعتقد ان دي مش فورمة VBA ممكن تكون خليه في الاكسل اعمل التنسيق بتاع الخليه علي الوقت العربي لو ما ظبطت ما تبخلش علينا استاذنا بالفرمه الجميله دي

و فيك بارك الله شكرا علي مرورك الجميل استاذنا

البرنامج دا هيفيدك جداجدا جدا من تصميمي برنامج فعلا رائع كما تحتاجه و اي استفسار انا في الخدمه

تفضل اخي و اي استفسار انا في الخدمه يمكنك التحميل من المرفقات تم التعديل علي الفورم 11 و تركت فورم 1 يمكنك نسخ الاكواد من فورم 11 الي مفاتيح الفورم 1 TOTAL QUOTATION BLOCKS & KERBS 01-03-2017.rar

حضرتك انا بعدل الملف و هيعجبك بإذن الله

بالتوفيق

تم إضافة رابط من علي ميديا فاير و ملف الاكسل الاصلي في المرفقات برجاء من اساتذتنا في المنتدي الغالي ان يقدموا ملاحظتهم يجب فك الضغط عند C:\GHANDOUR انسخ الملف المضغوط و اختار فك الي GHANDOUR او افتح ملف الاكسل مباسرة بتون الحاجه الي الملف التنفيذي المرفق ملف GH.rar هذا ملف الاكسل فقط برنامج حسابات الاصناف الاصدار الاول.rar GH.rar

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

فيه حاجه كمان بعيد عن كود البحث for لما تستخدم لزم تعلن عن المتغير بتاعها

السلام عليكم اللي فهمته من حضرتك اانك عاوز تظهر نتائج اكتر في الليست بوكس ولا ايه يبقي دا الكود اللي بتبحث بيه يبقي هاجي علي اول سطر و اقول ان مالوش لازمه في الكود طالما ان حطيت بعده on error resume next و كمان عند فنكشن البحث في سطر اف If Application.WorksheetFunction.Search(M, Q, 1) = 1 Then هغير رقم واحد اللي بعد Q هاخليه (0 'ComboBox1_Find.value = Application.WorksheetFunction.Proper(ComboBox1_Find.value) On Error Resume Next Dim Ws As Worksheet Dim V As Integer Dim LastRow As Integer Dim M As String Dim Q, F ListBox1.Clear ListBox2.Clear If ComboBox1_Find.Text = "" Then GoTo 1 M = ComboBox1_Find.Text Set Ws = Sheets("Cases") With Ws LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row Set Q = .Range("F2:F" & LastRow).Find(M) If Not Q Is Nothing Then F = Q.Address Do If Application.WorksheetFunction.Search(M, Q, 0) = 1 Then ListBox1.AddItem Q.value ListBox2.AddItem Q.value ListBox1.List(V, 0) = Q.Offset(0, -5).value ListBox1.List(V, 1) = Q.Offset(0, -4).value ListBox1.List(V, 2) = Q.Offset(0, -3).value ListBox1.List(V, 3) = Q.Offset(0, -2).value ListBox1.List(V, 4) = Q.Offset(0, -1).value ListBox2.List(V, 0) = Q.Offset(0, 0).value ListBox2.List(V, 1) = Q.Offset(0, 1).value ListBox2.List(V, 2) = Q.Offset(0, 2).value ListBox2.List(V, 3) = Q.Offset(0, 3).value ListBox2.List(V, 4) = Q.Offset(0, 4).value ListBox2.List(V, 5) = Q.Offset(0, 5).value ListBox2.List(V, 6) = Q.Offset(0, 6).value ListBox2.List(V, 7) = Q.Offset(0, 7).value V = V + 1 End If Set Q = .Range("F2:F" & LastRow).FindNext(Q) Loop While Not Q Is Nothing And Q.Address <> F End If End With 1 Me.ComboBox4.value = "" Me.ComboBox5.value = "" Me.ComboBox6.value = "" Me.ComboBox7.value = "" Me.ComboBox8.value = "" Me.ComboBox9.value = "" Me.ComboBox10.value = "" Me.ComboBox4.Visible = False Me.ComboBox5.Visible = False Me.ComboBox6.Visible = False Me.ComboBox7.Visible = False Me.ComboBox8.Visible = False Me.ComboBox9.Visible = False Me.ComboBox10.Visible = False CommandButton5.Visible = False CommandButton7.Visible = False End Sub '================================================================================= 'Search by Lab Name Private Sub ComboBox2_Find_Change() On Error Resume Next ComboBox2_Find.value = Application.WorksheetFunction.Proper(ComboBox2_Find.value) Dim Ws As Worksheet Dim V As Integer Dim LastRow As Integer Dim M As String Dim Q, F ListBox1.Clear ListBox2.Clear If ComboBox2_Find.Text = "" Then GoTo 1 M = ComboBox2_Find.Text Set Ws = Sheets("Cases") With Ws LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row Set Q = .Range("H2:H" & LastRow).Find(M) If Not Q Is Nothing Then F = Q.Address Do If Application.WorksheetFunction.Search(M, Q, 1) = 1 Then ListBox1.AddItem Q.value ListBox2.AddItem Q.value ListBox1.List(V, 0) = Q.Offset(0, -7).value ListBox1.List(V, 1) = Q.Offset(0, -6).value ListBox1.List(V, 2) = Q.Offset(0, -5).value ListBox1.List(V, 3) = Q.Offset(0, -4).value ListBox1.List(V, 4) = Q.Offset(0, -3).value ListBox2.List(V, 0) = Q.Offset(0, -2).value ListBox2.List(V, 1) = Q.Offset(0, -1).value ListBox2.List(V, 2) = Q.Offset(0, 0).value ListBox2.List(V, 3) = Q.Offset(0, 1).value ListBox2.List(V, 4) = Q.Offset(0, 2).value ListBox2.List(V, 5) = Q.Offset(0, 3).value ListBox2.List(V, 6) = Q.Offset(0, 4).value ListBox2.List(V, 7) = Q.Offset(0, 5).value V = V + 1 End If Set Q = .Range("H2:H" & LastRow).FindNext(Q) Loop While Not Q Is Nothing And Q.Address <> F End If End With 1 Me.ComboBox4.value = "" Me.ComboBox5.value = "" Me.ComboBox6.value = "" Me.ComboBox7.value = "" Me.ComboBox8.value = "" Me.ComboBox9.value = "" Me.ComboBox10.value = "" Me.ComboBox4.Visible = False Me.ComboBox5.Visible = False Me.ComboBox6.Visible = False Me.ComboBox7.Visible = False Me.ComboBox8.Visible = False Me.ComboBox9.Visible = False Me.ComboBox10.Visible = False CommandButton5.Visible = False CommandButton7.Visible = False و يارب تكون المعلومه وصلت لو قصد حضرتك حاجه تانيه يريت توضح اكتر

بسم الله الرحمن الرحيم فورم رائع و افكار جيده من خلال فورم اضافة أكثر من يوزر و التعديل عليهم اقصد باسوردو دا شكل الفورم قبل التعديل عليه و دا النتاج النهائي التحميل من المرفقات و ايضا الفرم فقط كي تستخدمه مباشر multi username .rar

حسابات الاصناف 1.0.0 برنامج حسابات الاصناف الاصدار الاول 1.0.0 يتمتع البرنامج بكفائه عاليه علي الحفظ . البرنامج مجاني بالكامل . للنفاذ الي قاعدة بيانات المدير يجب عليك ان تدخل كلمة السر (باسورد ) المدير . نافذة بداية التشغيل ( شاشة الدخول الي البرنامج ) النافذة الاوليه ( الرئيسيه ) إختيار اوامر ( اقسام العمليات ) البرنامج ======================================== البرنامج من تصميمي و اي استفسار حول عمل البرنامج يمكنك الاتصال علي 01064166251 كما يمكنك التواصل عبر الوسائل التاليه : whats app 01064166251 Facebook mail.google google + ==================================== رابط تحميل البرنامج من علي جوجل درايف من هنا ==================================== احب ان اشكر فريق المنتدي و الاعضاء الاعزاء علي ما قدموه في هذا المنتدي الذي استفدت منه كثيرا لكم اطيب الامنيات و بالتوفيق للجميع =احمد الغندور=

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

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

كيف يمكن حذف الاسطر المشار اليها بدائره حمرا علما بأن عليها باسورد

شكرا جزيلا