قنديل الصياد

السلام عليكم .............. حل آ خر بعد اذن استاذى الفاضل ... عله يفى بالمطلوب =DATEDIF(A1;B1;"m") =(YEAR(A9)-YEAR(A8))*12+MONTH(A9)-MONTH(A8) مرفق ملف به التطبيق

شكرا اخى واستاذى العزيز وجزاك الله خير الجزاء

دالة Column لمعرفة عدد الاعمدة الموجود بها بيانات ... ( رقم العمود الذى اقف به ) =COLUMN(H1) مرفق ملف به التطبيق

كود إضافة القائمة المنسدلة إلى خلية في إكسل Sub Add_Drop_Down_Menu_Cell() With Range("C1").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _ Formula1:="=$B$1:$B$9" .IgnoreBlank = True .InCellDropdown = True End With End Sub مرفق ملف به التطبيق

كود لحذف البيانات من الخلايا الغير محمية وعدم حذف المعادلات فى الخلايا المحمية Sub ragab() On Error Resume Next ActiveSheet.Range("D2:N23").Value = vbNullString End Sub

كود لعرض معلومات عن الملف الذى تعمل عليه Sub ShowFolderSize(filespec) Dim fs, F, S Set fs = CreateObject("Scripting.FileSystemObject") Set F = fs.GetFile("E:\Bids.xls") S = "File Name :" & UCase(F.Name) & vbLf & _ "Total Size: " & FormatNumber(F.Size) & " Kbytes" & vbLf & _ "Created :" & F.DateCreated & vbLf & _ "Modifide :" & F.DateLastModified & vbLf & _ "Last Accessed: " & F.DateLastAccessed MsgBox S, 0, "File Size Info" Open "Log.log" For Append As #2 'Open file Print #2, S Close #2 'Close Exit Sub 'Exit End Sub ' Sub GetII() ' ShowFolderSize (filespec) ' End Sub

لك شكرى وامتنانى اخى الكريم واكثر الله من امثالك وجعل عملك فى ميزان حسناتك

كلمات جميلة من استاذى ومعلمى الكبير الاستاذ / جمال دغيدى ... أقف إجلالا وإحتراما وتوقيرا لكلماتك الراقية ڳّلُ أَلَشِڳَرٌ لٌڳَـ وَلٌهٌذّأَ أٌلَمَرِوَرِ أَلٌجَمَيَلَ

اخى العزيز تم تعديل الملف وفق ما تريد

اخى العزيز لقد قمت بعمل جمع تلقائى للعمود المطلوب ويظهر الجمع فى نهاية العمود وقمت ايضا بعمل حفظ تلقائى للملف ارجو ان يكون المطلوب

كود لتحديد الاعمدة حسب ما تريد Sub sRange_Select() Range("A1:A100,C1:C100,f1:f100").Select End Sub مرفق ملفق به التطبيق

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

السلام عليكم اخى العزيز اليك ما طلبت كود لحفظ ملف الاكسل تلقائيا دون الضغط على ايقونة الحفظ حفظ تلقائى للبيانات فى ملف اكسل دون الضغط على ايقونة الحفظ ويوضع الكود فى WorkBook Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayAlerts = False ThisWorkbook.Save Application.Quit End Sub ومرفق ملف مطبق عليه الكود

السلام عليكم انظر اخى العزيز للمرفق لعله يكون المطلوب والا فقم بارفاق ملف للعمل عليه

كود لساعة جميلة أعجبتنى يوضع الكود التالى اولا فى صفحة WorkBook Private Sub Workbook_Open() Call StartClock End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Call StopClock End Sub ثم الأكواد التالية فى صقحة الموديل Moddule1 Option Explicit Dim NextTick Sub StartClock() UpdateClock End Sub Sub StopClock() ' Cancels the OnTime event (stops the clock) On Error Resume Next Application.OnTime NextTick, "UpdateClock", , False End Sub Sub cbClockType_Click() ' Hides or unhids the clock With ThisWorkbook.Sheets("Clock") If .DrawingObjects("cbClockType").Value = xlOn Then .ChartObjects("ClockChart").Visible = True Else .ChartObjects("ClockChart").Visible = False End If End With End Sub Sub UpdateClock() ' Updates the clock that's visible Dim Clock As Chart Set Clock = ThisWorkbook.Sheets("Clock").ChartObjects("ClockChart").Chart If Clock.Parent.Visible Then ' ANALOG CLOCK Const PI As Double = 3.14159265358979 Dim CurrentSeries As Series Dim s As Series Dim x(1 To 2) As Variant Dim v(1 To 2) As Variant ' Hour hand Set CurrentSeries = Clock.SeriesCollection("HourHand") x(1) = 0 x(2) = 0.5 * Sin((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12)) v(1) = 0 v(2) = 0.5 * Cos((Hour(Time) + (Minute(Time) / 60)) * (2 * PI / 12)) CurrentSeries.XValues = x CurrentSeries.Values = v ' Minute hand Set CurrentSeries = Clock.SeriesCollection("MinuteHand") x(1) = 0 x(2) = 0.8 * Sin((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60)) v(1) = 0 v(2) = 0.8 * Cos((Minute(Time) + (Second(Time) / 60)) * (2 * PI / 60)) CurrentSeries.XValues = x CurrentSeries.Values = v ' Second hand Set CurrentSeries = Clock.SeriesCollection("SecondHand") x(1) = 0 x(2) = 0.85 * Sin(Second(Time) * (2 * PI / 60)) v(1) = 0 v(2) = 0.85 * Cos(Second(Time) * (2 * PI / 60)) CurrentSeries.XValues = x CurrentSeries.Values = v Else ' DIGITAL CLOCK ThisWorkbook.Sheets("Clock").Range("DigitalClock").Value = CDbl(Time) End If ' Set up the next event one second from now NextTick = Now + TimeValue("00:00:01") Application.OnTime NextTick, "UpdateClock" End Sub مرفق ملف به التطبيق

أسعد الله قلوبكم وأمتعها بالخير دوماً أسعدني كثيراً مروركم وتعطيركم هذه الصفحه وردكم المفعم بالحب والعطاء دمتم بخير وعافيه

مجموعة اكواد اعجبتنى الكود الاول : تحية منى لاساتذتى بالمنتدى الرائع Sub Elsiad() ' ' Elsiad ماكرو ' الماكرو مسجل ‎28/06/2013 بواسطة ‎Basim Magdy Range("j1").Select ActiveCell.FormulaR1C1 = "بسم الله الرحمن الرحيم" Range("j2").Select ActiveCell.FormulaR1C1 = "تحياتى لكل اساتذتى بمنتديات أوفيسنا" Range("j3").Select ActiveCell.FormulaR1C1 = "الاستاذ / عبد الله باقشير" Range("j4").Select ActiveCell.FormulaR1C1 = "الاستاذ / أحمد فضيلة" Range("j5").Select ActiveCell.FormulaR1C1 = "الاستاذ / رجب جاويش" Range("j6").Select ActiveCell.FormulaR1C1 = "الاستاذ / حماده عمر" Range("j7").Select ActiveCell.FormulaR1C1 = "الاستاذ / هانى عدلى " Range("j8").Select ActiveCell.FormulaR1C1 = "الاستاذ / جمال عبد السميع " Range("j9").Select ActiveCell.FormulaR1C1 = "الاستاذ / احمد عبد الناصر " Range("j10").Select ActiveCell.FormulaR1C1 = "الاستاذ / شوقى ربيع " Range("j11").Select ActiveCell.FormulaR1C1 = "الاستاذ / جمال دغيدى " Range("j12").Select ActiveCell.FormulaR1C1 = "الاستاذ / طارق محمود " Range("j13").Select ActiveCell.FormulaR1C1 = "الاستاذ / ضاحى الغريب " Range("j14").Select ActiveCell.FormulaR1C1 = "الاستاذ / عبد الله المجرب " Range("j15").Select ActiveCell.FormulaR1C1 = "الاستاذ / سعيد بيرم " Range("j16").Select End Sub الكود الثانى : دعاء وحصن جميل Sub Hellomsg() donkeyain: Msg = "[ حصن لوقاية الانسان من شياطين الانس والجان ] " Ans = MsgBox(Msg, vbYesNo) If Ans = vbNo Then MsgBox "هل تود الذهاب الى الدعاء" GoTo donkeyain Else MsgBox "تحصنت بذى العزة والجبروت واعتصمت برب الملكوت وتوكلت على الحى الذى لا يموت & اصرف عنا الأذي انك على كل شئ قدير " End If End Sub الكود الثالث : ترحيل بيانات Sub sRange_Move() Sheets("ورقة2").Range("A9:c12").ClearContents Sheets("ورقة2").Range("a9:c12").ClearContents Sheets("ورقة2").Range("a9:c12").Value = Sheets("ورقة1").Range("A9:c12").Value End Sub الكود الرابع : جمع رقمين او اكثر Sub AddEmUp() Sum = 50 + 170 + 30 MsgBox "النتيجة = " & Sum End Sub الكود الخامس : حفظ تلقائى للبيانات فى ملف اكسل دون الضغط على ايقونة الحفظ ويوضع الكود فى WorkBook Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayAlerts = False ThisWorkbook.Save Application.Quit End Sub ومرفق ملف اكسل به تطبيقات لهذه المجموعة من الاكواد

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

فيديو الترحيل باستخدام الفلترة حمل من هنا

اخوانى واساتذتى الاعزاء اليكم بعض الاكواد التى اعجبتنى كود يقوم بحفظ واغلاق ملف الاكسل Sub FermetureExcel() Dim Wb As Workbook For Each Wb In Application.Workbooks Wb.Save Next Wb Application.Quit End Sub كود لتحويل الاحرف الكبيرة الى احرف صغيرة فى الخلايا النشطة من كبتل الى صمول Sub Lowercase() For Each x In Selection x.Value = LCase(x.Value) Next End Sub كود تحديد عرض دقة الشاشة بجهازك Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Sub AfficherResolution() Largeur = GetSystemMetrics(0) Hauteur = GetSystemMetrics(1) MsgBox "عرض دقة الشاشة هو: " & Largeur & " على " & Hauteur End Sub كود تحديد الخلية النشطة والخلايا التي على يمينها Sub SelectToRight() Range(ActiveCell, ActiveCell.End(xlToRight)).Select End Sub كود تحديد الخلية النشطة والخلايا التي على يسارها Sub SelectToLeft() Range(ActiveCell, ActiveCell.End(xlToLeft)).Select End Sub كود زر أمر لكتابة ما تريد Sub kandeel_elsiad() Range("k1") = "أهلا ومرحبا بكم فى منتديات أوفيسنا" End Sub امسح الجملة المكتوبة ( اهلا ومرحبا بكم فى منتديات اوفيسنا ) واضغط على الكود لكى يكتب لك ماتريد

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

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

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

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