اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر (معدل)

سلام الله عليكم أخوتى واساتذتى الكرام

كثيرا ما نواجه تضخم حجم الملف بسبب المعادلات أو الاكواد او الفورمات الخاصه بالشيتات

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

ولكن هل فى كود برمجى او طريقه لمعرفه ايا من الشيتات هو الاكثر حجما ؟؟؟

نعم هناك طريقه لمعرفه حجم كل شيت من ملف الاكسيل

 

Sub WorksheetSizes()
'Update 20140526
Dim xWs As Worksheet
Dim Rng As Range
Dim xOutWs As Worksheet
Dim xOutFile As String
Dim xOutName As String
xOutName = "KutoolsforExcel"
xOutFile = ThisWorkbook.Path & "\TempWb.xls"
On Error Resume Next
Application.DisplayAlerts = False
Err = 0
Set xOutWs = Application.Worksheets(xOutName)
If Err = 0 Then
    xOutWs.Delete
    Err = 0
End If
With Application.ActiveWorkbook.Worksheets.Add(Before:=Application.Worksheets(1))
    .Name = xOutName
    .Range("A1").Resize(1, 2).Value = Array("Worksheet Name", "Size")
End With
Set xOutWs = Application.Worksheets(xOutName)
Application.ScreenUpdating = False
xIndex = 1
For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> xOutName Then
        xWs.Copy
        Application.ActiveWorkbook.SaveAs xOutFile
        Application.ActiveWorkbook.Close SaveChanges:=False
        Set Rng = xOutWs.Range("A1").Offset(xIndex, 0)
        Rng.Resize(1, 2).Value = Array(xWs.Name, VBA.FileLen(xOutFile))
        Kill xOutFile
        xIndex = xIndex + 1
    End If
Next
Application.ScreenUpdating = True
Application.Application.DisplayAlerts = True
End Sub

منقول من موقع 

https://www.extendoffice.com/documents/excel/1682-excel-check-size-of-each-sheet.html

يارب يعجبكم الموضوع

 

وشكرا

تم تعديل بواسطه ابن الملك

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information