مارتن به این فکر می کند که آیا راهی برای یافتن اندازه هر کاربرگ در یک کتاب کار وجود دارد؟ او یک کتاب کار با تقریباً 100 کاربرگ دارد و می خواهد حجم فایل کتاب کار را کاهش دهد. با این حال، او نمی داند که کدام برگه ها از نظر اندازه بزرگتر هستند.
تعیین "اندازه" هر کاربرگ تا حد زیادی به معنای "اندازه" بستگی دارد. آیا این به معنی تعداد سلول های استفاده شده است؟ ستون ها و ردیف های استفاده شده؟ چه مقدار متن در کاربرگ ذخیره می شود؟ لیست معیارها می تواند ادامه یابد و ادامه یابد.
مشکل این است که سوالاتی از این دست نتیجه را از دست می دهند. یک کاربرگ می تواند موارد بسیار بسیار زیادی روی آن ذخیره شود. به عنوان مثال، میتواند حاوی نظرات، فرمولها، متن، نمودارها، فایلهای صوتی و هر تعداد مورد دیگر باشد. یک نمودار ممکن است از نظر تعداد سلول ها از دیگری بزرگتر باشد، اما دیگری می تواند از نظر اشیاء بزرگتر باشد (مانند نمودارها یا PivotTables).
تنها راه واقعی برای مقایسه اندازههای نسبی کاربرگها این است که هر کاربرگ را در کتاب کار خودش ذخیره کنید و سپس اندازه هر کتاب کار را بررسی کنید. این بدیهی است که به طور دقیق پاسخ نمی دهد که هر کاربرگ جداگانه چقدر است، زیرا عمل ذخیره یک کتاب کار، سربار اضافی را به فایل ذخیره شده وارد می کند. با این حال، اگر هر کاربرگ به روشی مشابه ذخیره شود، هر یک دارای سربار قابل مقایسه خواهد بود و بنابراین می توان با یکدیگر مقایسه کرد تا ببینید کدام بزرگتر است.
ماکرو زیر یک کاربرگ به کارنامه فعلی اضافه می کند تا اندازه هر کتاب کار ایجاد شده را ثبت کند. سپس از هر کاربرگ عبور کرده و آن را در یک کتاب کار جداگانه ذخیره می کند. سپس اندازه کتاب کار تعیین می شود، ثبت می شود و کتاب کار جدید حذف می شود.
Sub WorksheetSizes()
Dim wks As Worksheet
Dim c As Range
Dim sFullFile As String
Dim sReport As String
Dim sWBName As String
sReport = "Size Report"
sWBName = "Erase Me.xls"
sFullFile = ThisWorkbook.Path & _
Application.PathSeparator & sWBName
Add new worksheet to record sizes
On Error Resume Next
Set wks = Worksheets(sReport)
If wks Is Nothing Then
With ThisWorkbook.Worksheets.Add(Before:=Worksheets(1))
.Name = sReport
.Range("A1").Value = "Worksheet Name"
.Range("B1").Value = "Approximate Size"
End With
End If
On Error GoTo 0
With ThisWorkbook.Worksheets(sReport)
.Select
.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
Set c = .Range("A2")
End With
Application.ScreenUpdating = False
Loop through worksheets
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> sReport Then
wks.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sFullFile
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
c.Offset(0, 0).Value = wks.Name
c.Offset(0, 1).Value = FileLen(sFullFile)
Set c = c.Offset(1, 0)
Kill sFullFile
End If
Next wks
Application.ScreenUpdating = True
End Sub
