قنديل الصياد

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

الكود الاول : حفظ محتويات الملف الحالى باسم اخر Sub SaveAsDemo() Workbooks(1).SaveAs "منتديات اوفيسنا" End Sub الكود الثانى : اغلاق البرنامج مع حفظ البيانات Sub FermetureExcel() Dim Wb As Workbook For Each Wb In Application.Workbooks Wb.Save Next Wb Application.Quit End Sub الكود الثالث : عرض محتويات الهارد ديسك فى جهازك Option Explicit Private Declare Function GetDriveType Lib "kernel32" _ Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _ Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _ lpFreeBytesAvailableToCaller As Currency, _ lpTotalNumberOfBytes As Currency, _ lpTotalNumberOfFreeBytes As Currency) As Long Function DriveSize(DriveLetter As String) As String Dim Status As Long Dim TotalBytes As Currency Dim FreeBytes As Currency Dim BytesAvailableToCaller As Currency Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _ BytesAvailableToCaller, TotalBytes, FreeBytes) If Status <> 0 Then DriveSize = TotalBytes * 10000 Else DriveSize = "" End If End Function Function DriveSpaceFree(DriveLetter As String) As String Dim Status As Long Dim TotalBytes As Currency Dim FreeBytes As Currency Dim BytesAvailableToCaller As Currency Status = GetDiskFreeSpaceEx(DriveLetter & ":\", _ BytesAvailableToCaller, TotalBytes, FreeBytes) If Status <> 0 Then DriveSpaceFree = FreeBytes * 10000 Else DriveSpaceFree = "" End If End Function Function DriveType(DriveLetter As String) As String ' Returns a string that describes the type of drive of DriveLetter DriveLetter = Left(DriveLetter, 1) & ":\" Select Case GetDriveType(DriveLetter) Case 0: DriveType = "Unknown" Case 1: DriveType = "Non-existent" Case 2: DriveType = "Removable drive" Case 3: DriveType = "Fixed drive" Case 4: DriveType = "Network drive" Case 5: DriveType = "CD-ROM drive" Case 6: DriveType = "RAM disk" Case Else: DriveType = "Unknown drive type" End Select End Function Sub ShowAllDrives() Dim LetterCode As Long Dim Row As Long Dim DT As String Range("A1:D1") = Array("Drive", "Type", "Total Bytes", "Free Bytes") Row = 2 For LetterCode = 65 To 90 DT = DriveType(Chr(LetterCode)) If DT <> "Non-existent" Then Cells(Row, 1) = Chr(LetterCode) & ":\" Cells(Row, 2) = DT Cells(Row, 3) = DriveSize(Chr(LetterCode)) Cells(Row, 4) = DriveSpaceFree(Chr(LetterCode)) Row = Row + 1 End If Next LetterCode End Sub مرفق ملف به التطبيقات Book1.rar

استاذى الحبيب أطال الله فى عمرك وجعلك ذخرا لنا انظر هذا الرابط لعلى اكون قد عملت بما تقصد استاذى الحبيب http://www.officena.net/ib/index.php?showtopic=22634&hl= ومرفق الملف الموجود بالمشاركة حساب سن المعاش.rar

ولك اجمل وارق تحية اخى واستاذي الحبيب الاستاذ/ حمادة عمر

شكرا للاخوة والاساتذة الافاضل الاستاذ / على المصري الاستاذ الجميل الاستاذ / عبد الله المجرب واليكم ملف لحساب سن المعاش واقتبست معادلاته وفكره من اساتذتى الافاضل جزاهم الله كل الخير مرفق ملف به التطبيق حساب سن المعاش.rar

اولا شكرا لاستاذنا الحبيب ملك المعادلات الاستاذ / جمال عبد السميع وشكرا للاستاذ / محمد سعيد العمدة على الردود الجميلة والمفيدة والمثمرة اخى العزيز الرقم 21915 هذا الرقم ناتج ضرب 45سنة *365 يوم + 15 سنة * 366 يوم وذلك على اساس أن كل 3سنوات تأتى سنة تزيد يوم عن الثلاثة الماضية

الكود السادس : تحديد كامل الورقة Sub تحديد_الورقة() Cells.Select End Sub الكود السابع: نسخ كامل الورقة Sub نسخ_الورقة() Selection.Copy End Sub الكود الثامن : لصق كامل الورقة في ورقة اخري Sub لصق_الورقة() ActiveSheet.Paste End Sub مرفق ملف به التطبيقات نسخ ولصق.rar

الكود الاول : تحويل النصوص ذات الاحرف الكبيرة الى صغيرة 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 FermetureExcel() Dim Wb As Workbook For Each Wb In Application.Workbooks Wb.Save Next Wb Application.Quit End Sub الكود الرابع : احتواء تلقائي لجميع الاعمدة Sub احتواء_تلقائي_للاعمدة() Cells.Select Selection.Columns.AutoFit End Sub الكود الخامس : احتواء تلقائي لعمود واحد Sub احتواء_تلقائي_لعمود() Columns("L:L").EntireColumn.AutoFit End Sub مرفق ملف به التطبيقات Book1.rar

وجزاك الله خيرا اخى واستاذى الحبيب

التنسيق الشرطي على مدى عند وجود حرف او كلمة مطابق للهدف تحميل الملف او حمل من المرفقات التنسيق الشرطي على مدى عند وجود حرف او كلمة مطابق للهدف.rar

تغيير قيمة خليتين متقابلتين كحجر الزهر تحميل الملف او حمل من المرفقات تغيير قيمة خليتين كحجر الزهر.rar

شرح لعمل دالة تعتمد على اسم الخلية (موضوع رائع واعجبنى ) تحميل الملف او حمل الملف من المرفقات تسميات النطاق 2.rar

يا حاج جعل الله حجك مبرور وسعيـك مشكور وذنبك مغفور وبتعبك مأجور ... وكل سنه لبيت الله تزور ... وحياتك كلها نور على نور .

جزاك الله خيرا اخى الحبيب / البروفسير على كلماتك الحميلة