الـعيدروس

السموحه اخي بن عليه لم ارى ردك الا بعد المشاركة

السلام عليكم تفضل اخ khhanna اعداد تقارير مدرسية.zip

السلام عليكم الاستاذ القدير عبدالله باقشير ( خبور خير ) حفظك الله زادك الله علما ورفعه كلنا شوق مثل هكذا دروس تلميذك أبو نصار تقبل تحياتي وفائق شكري

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

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

السلام عليكم الاستاذ الحبيب خبور خير حفظك الله الملف يعمل 100% اتضحت المشكلة عندي من الجهاز لاني جربت في جهاز اخر به 2010 غير السابق وعمل بكفائه جزاك الله خير وزادك علما الى علمك تقبل تحياتي وشكري

السلام عليكم استخدم اوفيس 2010 ملاحظتك سليمة استاذ عبدالله جربت الملف على جهاز به 2007 عملت القائمة كما لابد ان تكون جزاك الله خير تقبل تحياتي وشكري

السلام عليكم الاستاذ القدير خبور خير حفظك الله ورعاك تقويم ولااروع جزاك الله خير ملاحظة بسيطة في حال اختيار الهجري واستعراض الاشهر يظهر مسمى شهر محرم في BoxMonth فقط تقبل مروري

السلام عليكم الاخ الفاضل mahmoud-lee عمل رائع جزاك الله خير تقبل مروري

السلام عليكم بارك الله فيك اخي رجب جاويش وجزاك الله خير عمل جميل تقبل مروري

السلام عليكم الاخ الفاضل rid2006 تأكد من صحة كلمة السر أو الغي كلمة السر وارفق الملف مرة اخرى

السلام عليكم سلمت يمناك استاذ عبدالله ( حبور خير ) ملف قمة الإبداع تقبل مروري

السلام عليكم وهذه برضه طريقة ربما تفي بالغرض اطلع على المرفق AA.rar

الحمد لله اشكرك اخي طاهر على دعائك وكلماتك الطيبه ولك مثله اضعاف مضاعفه ملاحظه =========== الكود يقوم بإنشاء فورم مؤقت وحذفه بعد الاغلاق ==============

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

السلام عليكم الاخ الفاضل طاهر في حدث الصفحه وهذا المرفق وبه الكود تحياتي رسالة تنبيهية 4_ALI.rar

السلام عليكم بعذ اذن الأخوه الافاضل بيكون هكذا Option Explicit Public O_ALIDROOS As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, [A2:Z5000]) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False If Not O_ALIDROOS Is Nothing Then 0 O_ALIDROOS.Interior.Color = RGB(255, 255, 0) O_ALIDROOS.Font.Color = RGB(0, 0, 255) End If Target.Interior.Color = RGB(0, 0, 255) Target.Font.Color = RGB(255, 255, 0) Application.ScreenUpdating = True Application.EnableEvents = True Set O_ALIDROOS = Target Else GoTo 0 End If End Sub

السلام عليكم لتعدد الحلول استعين بهذا الكود عله يفي بالغرض Public AA As String Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Address = "$C$3" Then If Range("c4").Value + Range("c5").Value + Range("c6").Value + Range("c7").Value + Range("c8").Value = 0 Then If Range("c9").Value = "متعهد " Then AA = "متعهد وغير ملتزم بالأقساط" ali Else ali AA = "الموظف غير ملتزم بالأقساط ويلزمه إبرام تعهد" End If End If End If If Target.Address = "$C$3" Then If Range("c4").Value + Range("c5").Value + Range("c6").Value + Range("c7").Value + Range("c8").Value > 0 Then If Range("c9").Value = "متعهد " Then AA = "الموظف متعهد وملتزم بالأقساط" ali Else AA = "الموظف ملتزم بالأقساط ولكن يلزمه إبرام تعهد" ali End If End If End If End Sub Private Sub ali() Application.VBE.MainWindow.Visible = False Set A_ALI = ThisWorkbook.VBProject.VBComponents.Add(3) With A_ALI .Properties("Caption") = "ALidroos" .Properties("Width") = 233 .Properties("Height") = 84.75 End With Set N_ALI = A_ALI.designer.Controls.Add("Forms.label.1") With N_ALI .Name = "A_Label" .Caption = AA .Top = 12 .Left = 0 .Width = 228 .Height = 48 .Font.Size = 25 .Font.Name = "Traditional Arabic" .BackColor = &H80& .ForeColor = RGB(255, 255, 0) .TextAlign = fmTextAlignCenter End With VBA.UserForms.Add(A_ALI.Name).Show ThisWorkbook.VBProject.VBComponents.Remove A_ALI End Sub

السلام عليكم الاخ الحبيب أبو حنين اشكرك على مرورك العطر وكلماتك الطيبه الاخ الفاضل tofimoon4 اذا كان الاوفيس الذي تستخدمه 2007 اذهب الى خيارات الاكسل ثم تحفيز ( إظهار علامة تبويب المطور في الشريط ) ستظهر لك قائمة جديدة المسماه ( المطور ) ستجد من ضمن القائمة الزر المسمى ( إدراج ) انقر عليه ستظهر لك مجموعتين ( ازرار عاديه و أزرار Activex ) اختار أول زر من مجموعة Activex بعد انشاء الزر انقر عليه مرتين ستظهر لك قائمة فيجول الاكسل استخدم زري ( Ctrl + A ) ثم حذف بعدها انسخ الكود التالي والصقه في الحدث Dim AE As Boolean Private Sub CommandButton1_Click() On Error Resume Next Dim A As String If AE = True Then Me.CommandButton1.Caption = "النطاق غير محمي" Else Me.CommandButton1.Caption = "النطاق محمي" If Me.CommandButton1.Caption = "النطاق محمي" Then A = InputBox("ادخل الرمز لإلغاء الحماية", "منتدى أوفسينا") If IsNull(A) Or A = "" Then Exit Sub If A = 123 Then MsgBox "تم إلغاء الحماية", vbInformation, "إدخال صحيح" AE = True Me.CommandButton1.Caption = "النطاق غير محمي" Else MsgBox "الرمز غير صحيح", vbInformation, "تنبية !!!" Exit Sub End If ElseIf Me.CommandButton1.Caption = "النطاق غير محمي" Then AE = False MsgBox "تم تأمين النطاق", vbInformation, "الحمد لله" Me.CommandButton1.Caption = "النطاق محمي" End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If AE Then Exit Sub If Not Application.Intersect(Target, Range("myrange")) Is Nothing Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End Sub ارجو ان اكون وفقت في توصيل المعلومه في الجهاز الذي عليه حاليا ليس به برنامج الشرح ان شاء الله غدا سوف ارفق شرح في امان الله وحفظه

السلام عليكم الاخ الفاضل tofimoon4 جرب المرفق على السريع البسورد الافتراضي 123 وأي ملاحظات انا موجود تحياتي كود لحماية أكثر من نطاق بدون حماية الورقة_ALI.rar

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

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

السلام عليكم الاخ الفاضل skyblue هذا الكود في حدث Thisworkbook Private Sub Workbook_BeforeClose(Cancel As Boolean) Cancel = True End Sub وهذه الأكواد انسخها الى مودويل Private Const WS_MAXIMIZEBOX = &H10000 Private Const WS_MINIMIZEBOX = &H20000 Private Const GWL_STYLE = (-16) Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Dim BigSize As Boolean Dim SmallSize As Boolean Sub ShowMinMax(ShowMin As Boolean, ShowMax As Boolean) Dim WinInfo As Long WinInfo = GetWindowLong(Application.HWnd, GWL_STYLE) If ShowMin = True Then WinInfo = WinInfo Or WS_MINIMIZEBOX Else WinInfo = WinInfo And (Not WS_MINIMIZEBOX) End If If ShowMax = True Then WinInfo = WinInfo Or WS_MAXIMIZEBOX Else WinInfo = WinInfo And (Not WS_MAXIMIZEBOX) End If SetWindowLong Application.HWnd, GWL_STYLE, WinInfo End Sub Sub Auto_Open() With Application .ActiveWindow.DisplayHeadings = False .DisplayFormulaBar = False .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" End With BigSize = False Call ShowMinMax(True, False) End Sub Sub ClosewithoutSave() Application.EnableEvents = False Application.Quit ActiveWorkbook.Close SaveChanges:=False ActiveWindow.DisplayHeadings = True Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" BigSize = True Call ShowMinMax(SmallSize, BigSize) Application.EnableEvents = True End Sub اللهم علمنا ماينفعنا أكواد واجهة التطبيقات من أحد المواقع

السلام عليكم الاخ الاساذ الحبيب الشهابي اشكرك على المرور الكريم الاخ الاستاذ القدير عبدالله المجرب اشكرك على المرور وتشجيعك المستمر الاخ الفاضل skyblue حط هذا الكود في حدث Thisworkbook Private Sub Workbook_Open() ActiveWindow.DisplayHeadings = False Application.DisplayFormulaBar = False Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",FALSE)" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Cancel = True End Sub وهذا كودك وعليه بعض الاضافات Sub ClosewithoutSave() Application.EnableEvents = False Application.Quit ActiveWorkbook.Close SaveChanges:=False ActiveWindow.DisplayHeadings = True Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" Application.EnableEvents = True End Sub جرب ان شاء الله اكون افدتك

السلام عليكم جرب هذا الكود في حدث ThisworkbooK Private Sub Workbook_Open() ActiveWindow.DisplayHeadings = False Application.DisplayFormulaBar = False Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",FALSE)" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWindow.DisplayHeadings = True Application.DisplayFormulaBar = True Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" End Sub