Yasser Fathi Albanna

أتمنى أن يكون الموضوع عجب أحد من الأخوة

Protect All Worksheets in Workbook using VBA Sub sbProtectAllSheets() Dim pwd1 As String, pwd2 As String pwd1 = InputBox("Please Enter the password") If pwd1 = "" Then Exit Sub pwd2 = InputBox("Please re-enter the password") If pwd2 = "" Then Exit Sub 'Check if both the passwords are identical If InStr(1, pwd2, pwd1, 0) = 0 Or _ InStr(1, pwd1, pwd2, 0) = 0 Then MsgBox "You entered different passwords. No action taken" Exit Sub End If For Each ws In Worksheets ws.Protect Password:=pwd1 Next MsgBox "All sheets Protected." Exit Sub End Sub Insert a Module for Insert Menu ولحمايته لفترة زمنية كفترة تجريبية Sub workbook_open() If Time >= " 01-01-2016" Then msgbox "the time work of this application is finished" ThisWorkbook.Close False End Sub

بارك الله فيك وفى أعمالك الرائعة أبى وأستاذى القدير / محمد حسن المحمد جعله الله فى ميزان حسناتك

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

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

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

السلام عليكم ورحمة الله وبركاته أحبائى فى الله تقبلوا جميعا تحياتى أقدم لكم اليوم كود لعله يفيد Show Picture on Mouse Hover with VBA Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sh As Worksheet Set sh=Sheet1 If sh.Pictures("Smallman").Visible=False Then 'Smallman is the name of the pic sh.Pictures("Smallman").Visible=True End If sh.Shapes("Label1").Visible=True 'This line is the most important (No Delete) End Sub Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sh As Worksheet Set sh=Sheet1 If sh.Pictures("Smallman").Visible=True Then 'Smallman is the name of the pic sh.Pictures("Smallman").Visible=False End If sh.Shapes("Label1").Visible=False 'This line is the most important (No Delete) End Sub Private Sub CommandButton1_Click() 'Excel VBA for command button add. MsgBox "Your Macro Here" End Sub Mouse Over the Command Button.rar

السلام عليكم ورحمة الله وبركاته أحبائى فى الله تقبلوا جميعا تحياتى أقدم لكم اليوم كود لعله يفيد Copy Each Sheet from Closed Workbooks Option Explicit Sub OpenImpShts() 'Excel VBA procedure to Copy each sheet from closed workbook. Const sPath="D:\Temp\" 'Change to suit Dim sFil As String Dim owb As Workbook Dim ws As Worksheet Dim sh As Worksheet Set ws=Sheet1 sFil=Dir(sPath & "*.xl*") Do While sFil <> "" 'Start the loop through Excel files. Set owb=Workbooks.Open(sPath & sFil) For Each sh In ActiveWorkbook.Sheets sh.[A2:AZ2000]=sh.[A2:AZ2000].Value sh.Copy After:=ws owb.Close False 'Close no save Next sh sFil=Dir Loop End Sub

السلام عليكم ورحمة الله وبركاته أحبائى فى الله تقبلوا جميعا تحياتى أقدم لكم اليوم كود لعله يفيد Delete All Pivot Tables with Excel VBA Sub RemPiv() 'Excel VBA to Delete all pivot tables in a worksheet. Dim Pt As PivotTable For Each Pt In ActiveSheet.PivotTables Pt.TableRange2.Clear Next Pt End Sub

السلام عليكم ورحمة الله وبركاته أحبائى فى الله تقبلوا جميعا تحياتى أقدم لكم اليوم كود لعله يفيد Delete All Macros Sub DeleteAllMacros() 'Excel vba to delete all macros in new workbook. Dim otmp As Object With ActiveWorkbook.VBProject For Each otmp In .VBComponents If otmp.Type=100 Then otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines otmp.CodeModule.CodePane.Window.Close Else: .VBComponents.Remove otmp End If Next otmp End With End Sub

رائع جزاك الله خيرا

إطمن أخى الحبيب / أبو وليد أستاذنا ومعلمنا الحبيب الغالى ياسر خليل بخير والحمد لله وبصحة جيدة بس فى المنطقة عنده كابل النت مقطوع وحتى الأن لم يتم إصلاحة

حبيبى الغالى أ / محمد الريفى أشكرك على رأيك الرائع هامش الربح الموضح بالمرفق الغرض منه هو توضيح للتاجر ربحيته بطريقة إن سعر المنتج صافى عليه بعد الضريبة مثلا 2.5 جنيه وسعر المستهلك 3 جنيه فهامش الربح له يساوى سعر المستهلك ناقص الصافى بعد الضريبة ÷ سعر المستهلك فيعطى نسبة هامش الربح ولا أدرى هل هذا صحيح أم لا وبالنسبة للمعادلة المطلوبة عبارة عن السعر قبل الضريبة ناقص خصم نقدى ثابت 2% + ضريبة المبيعات وقد نفزتها بالفعل كما يلى D4-(D4*2%)+(F4-E4= باقى المعادلة محيرنى المطلوب إن لو قيمة الصنف وصلت إلى 100 جنيه أخصم كمان 5 % قبل الضريبة وبعدين أضيف الضريبة مش عارف أنا كدا موضح ولا لا تقبل تحياتى

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

اخى الحبيب الغالى / عبد العزيز فى البداية أشكرك جدا لإهتمامك ومرورك الدائم الذى يسعدنى ويشرفنى دائما بالنسبة لخانة الخصم النقدى لا يوجد خانة فالخصم النقدى 2 % ثابت لكل الأصناف ويكتب يدوى بالمعادلة مثلا =B5*2% تقبل خالص تحياتى وتقديرى

عمل رائع جزاك الله خيرا

هل المطلوب غير واضح للرفع

للرفع

للرفع ولكم خالص الشكر والتقدير

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

أخى العزيز أنس دروبي عمل رائع

أخى عبد الباري البنا

أخى / عبدالباري البنا

حبيبى الغالى عبد العزيز شرح أكثر من رائع

بعد إذن أخى وحبيبى ومعلمى القدير أ / محمد الريفى عله يفى بالغرض AdvancedFilterDates.rar