• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

dosya büyüklüğü hk.

umitumit

Altın Üye
Katılım
5 Eylül 2006
Mesajlar
364
Excel Vers. ve Dili
Excel 2016
Türkçe
Arkadaşlar merhaba,

20 sayfadan oluşan ve her birinini birbirleri ile bağlantıları olan bir excel dosyam var.

Toplam boyut 127.728 KB

Acaba hangi sayfası bu kadar büyük görünmesine neden oluyor?

Nasıl bulabilirim?
 
Aşağıdaki kodu deneyin.

Kendi dosyamda denediğimde sapmalar olduğunu gördüm. Sayfaları ayrı ayrı dosya olarak kaydettiği için boyutları biraz değişiyor. Sanırım tutarsızlık bundan kaynaklanıyor.

Kodlar büyük ihtimalle işinizi görecektir.

Kodu çalıştırdığınızda masaüstüne "Sayfa Boyutları" adında bir klasör oluşturacaktır.

İşlem bitiminde bu klasörün içine bir excel dosyası kayıt edecektir. Dosyanın adı klasörle aynıdır.

Dosyayı açtığınızda sayfa boyutlarını görebilirsiniz.


Kod:
Sub Sheets_Size()
    Dim K1 As Workbook, Yol As String, X As Integer, Dosya_Adi As String
    Dim K2 As Workbook, S1 As Worksheet, Zaman As Double, Satir As Integer
    
    Zaman = Timer
    
    Set K1 = ActiveWorkbook
    ReDim Dizi(0 To K1.Sheets.Count, 1 To 2)
    
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Sayfa Boyutları\"
    
    On Error Resume Next
    MkDir Yol
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    On Error GoTo Son
    
    With CreateObject("Scripting.FileSystemObject")
        Dosya_Adi = Yol & K1.Name & ".TMP"
        Dizi(0, 1) = K1.Name
        Dizi(0, 2) = .GetFile(K1.FullName).Size
        On Error Resume Next
        For X = 1 To K1.Sheets.Count
            K1.Sheets(X).Copy
            ActiveWorkbook.SaveCopyAs Dosya_Adi
            Dizi(X, 1) = K1.Sheets(X).Name
            Dizi(X, 2) = .GetFile(Dosya_Adi).Size
            ActiveWorkbook.Close False
        Next
        On Error GoTo 0
        Kill Dosya_Adi
    End With
    
    Set K2 = Workbooks.Add(1)
    Set S1 = K2.ActiveSheet
    
    Satir = 2
    
    S1.Range("A1:B1") = Array("SAYFA ADI", "BOYUT (Byte)")
    S1.Range("A1:B1").Font.Bold = True
    S1.Range("A1:B1").Font.ColorIndex = 3
    S1.Range("A1:B1").HorizontalAlignment = xlCenter
    
    For X = 0 To UBound(Dizi)
        S1.Cells(Satir, 1) = Dizi(X, 1)
        S1.Cells(Satir, 2) = Dizi(X, 2)
        Satir = Satir + 1
    Next
    
    S1.Cells.EntireColumn.AutoFit
    Application.DisplayAlerts = False
    K2.SaveAs Yol & "Sayfa Boyutları.xls", 56
    K2.Close 0
    Application.DisplayAlerts = True
    
Son:
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    If Err Then MsgBox Err.Description, vbCritical, "Error"

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Sayın Korhan Ayhan,

Çok teşekkürler.
Arkadaşım hücre seçmek yerine sütun seçerek biçimlendirme yapınca, aşağı doğru ne var ne yok boyamış. Tabi böyle olunca dosya boyutu garip bir hale gelmiş.
Sayenizde bulduk ve düzelttik.

Teşekkürler
 
Geri
Üst