قنديل الصياد قام بنشر أكتوبر 28, 2013 مشاركة قام بنشر أكتوبر 28, 2013 الكود الاول : حفظ محتويات الملف الحالى باسم اخر 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 رابط هذا التعليق شارك More sharing options...
ابو الآء قام بنشر أكتوبر 28, 2013 مشاركة قام بنشر أكتوبر 28, 2013 الف شكر اخى الحبيب ذكرتنى بملف للعلامه خبور خير وهو حافظه للاكواد عمل رائع سلمت يداك رابط هذا التعليق شارك More sharing options...
قنديل الصياد قام بنشر أكتوبر 28, 2013 الكاتب مشاركة قام بنشر أكتوبر 28, 2013 رابط هذا التعليق شارك More sharing options...
حمادة عمر قام بنشر أكتوبر 29, 2013 مشاركة قام بنشر أكتوبر 29, 2013 جزا ك الله خيرا جزا ك الله خيرا جزا ك الله خيرا جزا ك الله خيرا رابط هذا التعليق شارك More sharing options...
قنديل الصياد قام بنشر أكتوبر 29, 2013 الكاتب مشاركة قام بنشر أكتوبر 29, 2013 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان