قنديل الصياد

كل عام وحضرتك بخير وشاكر جدا على الجمال والروعة والابداع المستمر يا استاذى ويا اخى العزيز

شكرا اخى العزيز استاذ / مصطفى

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

اخوانى واساتذتى الافاضل بمنتدانا الجميل

أعجبنى فورم لاحد الاساتذة هنا فى المنتدى ( سبورة الحروف ) فاردت ان اعرضه مرة اخرى

فشكرا جزيلا لكل الاساتذة والاخوة الافاضل هنا فى منتدانا العظيم

إليكم اهدي هذه الكلمات
ويتراقص لها قلمي على الصفحات ليهديكم أجمل العبارات
عبارات تحمل في ثناياها الشكر على المرور

سلمت الأيادي

فبوركت أياديكم المعطاءة لمنتداكم الوقور
الذي أكن له كل الحب والتقدير

اساتذتى الاعزاء

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

اساتذتى الكرام

برجاء التعديل على الملف المرفق

السلام عليكم  .............. حل آ خر

بعد اذن استاذى الفاضل   ... عله يفى بالمطلوب

=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

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

الاخ العزيز  : رفع النتائج على النتائج يحتاج الى موقع مدفوع

اريد ان اعلمك اننى قمت بعرض موضوع عن ذلك بمنتديات ثانوية واليك الاتى :

سيقوم منتدى ثانوية بعمل صفحات للمدارس لتحميل نتائجها على النت

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

قم بالدخول من هنا على رابط منتديات ثانوية