الـعيدروس

المرفق في المشاركه السابقه

السلام عليكم الاخ الفاضل EXTROARDINARY PREDATOR الملف به كلمة مرور حماية

السلام عليكم الاخ الفاضل إبراهيم ابوليله تفضل Option Explicit Sub S_Tool() '=================== ' إنشاء Toolbar '=================== Dim A As CommandBar, B As CommandBarControl On Error Resume Next CommandBars("A_Toolbar").Delete Set A = CommandBars.Add(Name:="A_Toolbar", Position:=msoBarFloating, Temporary:=True) A.Visible = True Set B = A.Controls.Add(msoControlButton, 1695, , , True) With B '======================================= .Caption = "Ali_T" 'تسمية .TooltipText = "Run Ali_T" ' تعليق .OnAction = "Ali_T" ' إسم الماكرو المراد تفعليه '======================================= End With End Sub Sub Ali_T() [A1].Value = "منتدى أوفسينا" MsgBox "منتدى أوفسينا" End Sub Sub D_Tool() '=================== ' حذف Toolbar '=================== On Error Resume Next CommandBars("A_Toolbar").Delete End Sub شاهد الزر في قائمة Add-Ins Ali_Toolbar.rar

السلام عليكم الاخ الاستاذ هاني عدلي الف الف مبروك عليك الترقيه الى مزيد من التقدم تقبل مروري

السلام عليكم هذا السطر الصقة في حدث الفورم UserForm_Activate Me.TextBox1.Value = Format(Now(), "yyyy/mm/dd") اما الطلب الاخر لو ترفق ملف يكون افضل

السلام عليكم الاخ الفاضل klma7lwa استخدم هذا الكود Sub Ali() CC = 9 For C = 1 To 4 For R = 1 To Cells(Rows.Count, 1).End(xlUp).Row Cells(R, CC).Value = Cells(R, C).Value Next CC = CC - 1 Next End Sub

السلام عليكم الاخ الفاضل nicola السموحه على التأخير في الرد تفضل جرب المرفق فورم بحث بامكانية التصفية_3.rar

الاكسل زر فقط ليس به اي فورم

السلام عليكم الاخ الفاضل أبوســـارة1973 حط مثال يوضح المطلوب في الاكسل

السلام عليكم بتكون هكذا الصيغة =ISERROR(IF(VLOOKUP(L21;F.S!$A$16:$G$50;7;0);"";VLOOKUP(L21;F.S!$A$16:$G$50;7;0)))

السلام عليكم الاخ الفاضل إبراهيم ابوليله اعتقد من اعدادت الاكسل ثم تخصيص ثم من " اختيار الأوامر من " تختار من القائمة وحدات الماكرو تختار الماكرو المراد تثبيت اختصاره ضمن الاطار الخاص بالاكسل ثم اضافة لعلي افدتك

السلام عليكم استخدم هذه الاوامر هذا السطر في اول الكود فرضا اسم الورقة "ورقة1" وباسورد الحماية "123" إلغاء الحماية ورقة1.Unprotect Password:="123" وهذا السطر في اخر الكود لإسترجاع حماية الورقة ورقة1.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True

الاخ الحبيب ياسر الحافظ اشكرك على كلماتك الرقيقة ارجو تجربه المرفق فورم ضمن فورم_2.rar

السلام عليكم الحمد لله على السلامه اخي ياسر الحافظ أسال الله ان ينعم عليكم الامان ويعينكم والانتصار العاجل بأذن الله جرب المرفق عله ماتريد والسلام عليكم فورم ضمن فورم _1.rar

جرب المرفق ربما يفي بالغرض

في الجزء المشار في الكود فرضا اسم الكود macro1 Sub P_ALIDROOS_CP() Dim Ol_AIDROOS Dim T_ALIDROOS As Integer Dim i As Integer Dim P_G_ALIDROOS As Single T_ALIDROOS = 2500 Ol_AIDROOS = Application.DisplayStatusBar For i = 2 To T_ALIDROOS Application.StatusBar = "تقدم النتيجــة => " & Format(i / T_ALIDROOS * 10, "##0.00") & "%" P_G_ALIDROOS = i / T_ALIDROOS Call CP_ALIDROOS_CP(P_G_ALIDROOS) Next '=========================== Call macro1 ' اسم الكود المرادان يعمل مع splash screen '=========================== Application.StatusBar = False Application.DisplayStatusBar = Ol_AIDROOS Unload UserForm1 Call ALIDROOS_CP_MSG End Sub

السلام عليكم الاخ الفاضل وسيم العش هل هذا ماتقصد B_ALIDROOS.rar

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

السلام عليكم بعد اذن الاستاذ العلامه عبدالله باقشير حفظه الله الاخ الفاضل nicola تفضل استخدم الكمبوكس لإختيار الورقة المراد البحث فيها فورم بحث بامكانية التصفية_1.rar

السلام عليكم تفضل Sub F_Date() Dim SD As String Dim CF As Range, SR As Range, LC As Range Set SR = ورقة1.Range("A1:A100") Set LC = SR.Cells(SR.Cells.Count) A = InputBox("إدخل التاريخ المراد", "منتدى أوفسينا") SD = Format(A, "Short Date") If IsDate(SD) = False Then MsgBox "تنسيق التاريخ غير صحيح" Exit Sub End If Set CF = SR.Find(What:=CDate(SD) _ , After:=LC, LookIn:=xlFormulas, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not CF Is Nothing Then Cells(CF.Row, ActiveCell.Column).Select Else MsgBox "لاتوجد نتائج لهذا البحث" End If End Sub

السلام عليكم الكود يعمل 100% عندي تقبلو مروري

السلام عليكم الاخ الفاضل lvhsdl تم اضافة اخفاء شريط الصفحات تفضل المرفق C_SHOW_A_1.zip

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

السلام عليكم الأخ طاهر تفضل المرفق فورم معلومات Ali.zip

السلام عليكم بعد اذن الاخ الفاضل ابو حنين تفضل اخ طاهر فورم معلومات1.zip