Excel de Sayfa Boyutu öğrenmek için kod

[selo1234]

Merhabalar,
Excel dosyasındaki sayfaların boyunu verecek kodu arıyorum.
Formda arama yaptığımda hep dosya boyutunu ver LEN fonksiyonu karşıma çıkıyor.
Sayfa boyutu için kod bilen var mı acaba?
İyi çalışmalar, şimdiden teşekkürler
selo1234

 

[Kemal Demir]

Merhaba,

Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(ThisWorkbook.Path)
    s = UCase(f.Name) & " uses " & f.Size & " bytes."
    MsgBox s, 0, "Folder Size Info"

Yukarıdaki kod zannedersem işinizi görür.

NOT:Klasor içerisinde tüm dossyaların boyutunu veriyor olabilir.Böylebir sonuc ise dosyanızı boş bir klasore koyunuz.(Denemedim belki sadece dosya boyutunu veriyorda olabilir)

 

[selo1234]

teşekkürler,
ama sanırım bu dosya boyutunu veriyor. Ben dosyadaki sayfaların boyutunu almak istiyorum.

 

[Kemal Demir]

?
Bilemiyorum.

 

[selo1234]

İlgilenen olur diye internet de bulduğumu paylaşmak istiyorum.
İnternet de bir istede aşağıdaki kodu buldum. Bu sub , workbook daki tüm sayafaları alıp, her sayfadan bir workbook yaratıyor. Böylece , her sayfanın boyutunu görmek, hangisinin büyük boyutta olduğunu görmek mümkün oluyor. Tabii, "fileismi" yerine kullanığınız dosyanın ismini, path i ile birlikter yazmayı unutmayın.
Bu arada, excel deki pivot tablolarda çok büyük boyut oluşturuyor, bilgilerinize.
selo1234

Option Explicit

Sub MakeMultipleXLSfromWB()
'Split worksheets in current workbook into
' many separate workbooks D.McRitchie, 2004-06-12
'Close each module AND the VBE before running to save time
' provides a means of seeing how big sheets really are
'Hyperlinks and formulas pointing to other worksheets within
' the original workbook will usually be unuseable in the new workbooks.
Dim CurWkbook As Workbook
Dim wkSheet As Worksheet
Dim newWkbook As Workbook
Dim wkSheetName As String
Dim shtcnt(3) As Long
Dim xpathname As String, dtimestamp As String
dtimestamp = Format(Now, "yyyymmdd_hhmmss")
xpathname = "c:\fileismi" & dtimestamp & "\"
MkDir xpathname
Set CurWkbook = Application.ActiveWorkbook

shtcnt(2) = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each wkSheet In CurWkbook.Worksheets
shtcnt(1) = shtcnt(1) + 1
Application.StatusBar = shtcnt(1) & "/" & shtcnt(2) & _
" " & wkSheet.Name
wkSheetName = Trim(wkSheet.Name)
If wkSheetName = Left(Application.ActiveWorkbook.Name, _
Len(Application.ActiveWorkbook.Name) - 4) Then _
wkSheetName = wkSheetName & "_D" & dtimestamp
Workbooks.Add
ActiveWorkbook.SaveAs _
filename:=xpathname & wkSheetName & ".xls", _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", CreateBackup:=False, _
ReadOnlyRecommended:=False
Set newWkbook = ActiveWorkbook

Application.DisplayAlerts = False
newWkbook.Worksheets("sheet1").Delete
On Error Resume Next
newWkbook.Worksheets(wkSheet.Name).Delete
On Error GoTo 0
Application.DisplayAlerts = True

CurWkbook.Worksheets(wkSheet.Name).Copy Before:=newWkbook.Sheets(1)
'no duplicate sheet1 because they begin with "a"
ActiveWorkbook.Save
ActiveWorkbook.Close
Next wkSheet
Application.StatusBar = False 'return control to Excel
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub