الـعيدروس

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

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

السلام عليكم جرب المرفق بيانات القائمة المنسدله تكتبها في الاعمدة التي عليها التعليق في ورقة 1 Q_ADD_FORM_ALI.rar

السلام عليكم اطلع على المرفق للعلم تم الاستعانه بعمود إضافي تجميع الخلايا في خلية واحدة _ ali.rar

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

جرب هكذا Public Sub ali() For T = 7 To [D1500].End(xlUp).Row If Cells(T, 4).Value > "" Then Cells(T, 4) = Range("E2").Value & " _ " & Cells(T, 4).Value End If Next T End Sub

السلام عليكم الاخ الفاضل ضى النور استخدمت الكود في ملف اخر فعمل معي 10/10 والله لااعلم ماذا حل بالملف ولاكن احاول اليوم مرة اخرى علي اتوصل الى حل

السلام عليكم الفكره صعبة شويات ويحتاج لها لمسات احد الاساتذة الكبار

السلام عليكم وين مشكلة التاريخ ارجو التوضيح

السلام عليكم جرب هذا الكود Public Sub ali() For T = 7 To Range("D15000").End(xlUp).Row If Range("E2").Value > Empty Then Cells(T, 6) = Range("E2") & " - " & Range("D" & T) Else Cells(T, 6) = Empty End If Next T End Sub

عفواً الكود بيكون هكذا Private Sub CommandButton1_Click() A = ورقة2.Range("B9").Value B = ورقة2.Range("B15000").End(xlUp).Value [A4].Value = B: [B4].Value = ورقة2.Range("B" & B).Value For C = Range("B4").Value To Range("A4").Value ComboBox1.Value = C Range("Print_Area").PrintOut Copies:=1 Next C End Sub

طلبك زر للكل هل هذا صحيح هل جربت وماهي النتائج إن كان ولابد تريد استخدام الرقم المالي ضيف عمود مساعد في التحضير اليومي واعمله كـ مسلسل مثلا B العمود المساعد C الرقم المالي

امسح الكود واستبدله بهذا ربما يعمل معاك عند إثبات متغير Private Sub UserForm_Initialize() On Error Resume Next Dim mycol As Collection Dim myrng As Range Dim I% Set mycol = New Collection For Each myrng In Range("الاسماء3") mycol.Add myrng.Value, myrng.Text Next myrng For I = 1 To mycol.Count If mycol.Item(I) = "" Then mycol.Remove I Me.ComboBox2.AddItem mycol(I) Next I End Sub

السلام عليكم اضن هكذا طلبك ولاكن بشرط أن تكون الأرقام متسلسله لايقطعها اي تسلسل بمعنى ( 1-2-3-4-5) وهكذا اطلع على المرفق غيرت التسلسل حق الرقم المالي الذي في ورقة البيانات والتحضير اليومي الذي اضنه بهذا الوضع يتماشى مع طلبك اتمنى أن يكون المطلوب جرب واخبرني النتيجه PRINT222.rar

السلام عليكم طلبك رخيص هل البداية هكذا اطلع على المرفق Q_ADD_FORM.rar

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

السلام عليكم لاعليك هذا الكود وبه طلبك Sub MKARNH_ALI() Application.ScreenUpdating = False '=============================== ' إلغاء الباسورد للورقة النشطه قبل عمل الكود ActiveSheet.Unprotect ("123") '=============================== Range("j3:K7000").ClearContents Q = [E15000].End(xlUp).Row For R = 3 To Q If Application.WorksheetFunction.CountIf([F3:F5000], Cells(R, 5)) = 0 Then With Columns(10).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 5) End With End If Next RO = [F15000].End(xlUp).Row For R = 3 To RO If Application.WorksheetFunction.CountIf([E3:E5000], Cells(R, 6)) = 0 Then With Columns(11).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 6) End With End If Next T = [J15000].End(xlUp).Row Z = [K15000].End(xlUp).Row [H6].Value = Application.WorksheetFunction.Count(Range([J3], Cells(T, "J"))) [H12].Value = Application.WorksheetFunction.Count(Range([K3], Cells(Z, "K"))) Application.ScreenUpdating = True MsgBox "الحمد لله", vbInformation, "تمت المقارنة" '=================================== ' إسترجاع الرقم السري للورقة النشطه بعد تنفيذ الكود ActiveSheet.Protect Password:="123" '==================================== End Sub في حال انك تريد تغير الباسورد بدلا عن 123 غيره من الكود من هذا السطر اول الكود الى اي رقم تريده ActiveSheet.Unprotect ("123") وبرضه من هذا السطر في اخر الكود ActiveSheet.Protect Password:="123"

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

السلام عليكم اخي الفاضل Eid Mostafa الفلترة بتعلم عملها مزبوط مافيه اي مشاكل ولاكن انت طلبك تظهر الاجمالي فهذا ليس من عمل الفلترة الفلترة تقوم بإظهار النتيجة المطلوبة بالشرط فقط هذا والله اعلم

اخي اضف في اول الكود الغاء الحماية وفي اخر الكود استرجاع الحمايه هكذا بيكون الكود بعد الاضافه فرضا ان باسورد الورقة 123 SUB A () ' تسمية وهمية للكود غيرها من الكود الفعلي الذي لديك ' فرضا أنا الباسورد 123 '========================= ' إالغاء الباسورد للورقة النشطة قبل تنفيذ الكود ' activesheet.unprotect ("123") '========================= ' نحط الكود هنا '========================= ' إسترجاع الحماية للورقة النشطه بعد تنفيذ الكود ' activesheet.protect password:="123" '========================= END SUB

احاول ان شاء الله والنتيجة غير متوقعه

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

ضلل الكود السابق وحط هذا بداله هذا نفس كود الاستاذ الحبيب يحياوي ولاكن سوى عند اختيار نعم او لاا يحفظ Private Sub CommandButton1_Click() Unload Me If MsgBox("هل تريد الخروج", vbYesNo, "خروج") = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.Save Application.Quit End If ActiveWorkbook.Save Sheets("البيانات").Select End Sub

اثبات متغيرات فقط روح للفورم CTRL + A ولصقت هذا الكود هذا نفس الكود لاكن بإثبات كل المتغيرات فقط Private Sub CommandButton1_Click() Dim dd, col, m dd = Application.WorksheetFunction.VLookup(CDbl(ComboBox1.Value), Sheets("data_entry").Range("Am4:an35"), 2, False) col = dd + 3 For m = 5 To 13 Sheets("data_entry").Cells(m, col).Value = CDbl(TextBox3) Next m For m = 17 To 61 Sheets("data_entry").Cells(m, col).Value = CDbl(TextBox3) Next m For m = 67 To 79 Sheets("data_entry").Cells(m, col).Value = CDbl(TextBox3) Next m For m = 83 To 117 Sheets("data_entry").Cells(m, col).Value = CDbl(TextBox3) Next m For m = 121 To 125 Sheets("data_entry").Cells(m, col).Value = CDbl(TextBox3) Next m MsgBox "Êã ÇáãØáæÈ", vbMsgBoxRight, "ÊãÊ ÈÍãÏ Çááå" End Sub Private Sub CommandButton3_Click() ActiveWorkbook.Save Me.Hide End Sub Private Sub OptionButton1_Click() Dim dd, col dd = Application.WorksheetFunction.VLookup(CDbl(ComboBox1.Value), Sheets("data_entry").Range("Am4:an35"), 2, False) col = dd + 3 Sheets("data_entry").Cells(Label6.Caption, col).Value = CDbl(TextBox3) End Sub Private Sub OptionButton2_Click() Dim dd, col dd = Application.WorksheetFunction.VLookup(CDbl(ComboBox1.Value), Sheets("data_entry").Range("Am4:an35"), 2, False) col = dd + 3 Sheets("data_entry").Cells(Label6.Caption, col).Value = CDbl(TextBox3) End Sub Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) On Error Resume Next Label4.Caption = Application.WorksheetFunction.VLookup(CInt(TextBox2), Sheets("data_entry").Range("A5:c177"), 3, False) Label6.Caption = Application.WorksheetFunction.VLookup(CInt(TextBox2), Sheets("data_entry").Range("A5:c177"), 2, False) End Sub

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