Dosya boyutunu artıran Excel Çalışma Kitabı nesnesine ne gider?

Question

Kullanmakta olduğum bir Excel çalışma kitabının dosya boyutunu küçültmeye çalışıyorum. Zaten kullanılmayan satırların bir konu ve gereksiz imajlar vb. Olduğunu biliyorum. Gizem, neden sadece büyümek gibi gözüken gizli bir bölümün var olduğudur.

Ben

Sub workbook_objectsize() 
    With CreateObject("Scripting.FileSystemObject") 
      Set wb = ActiveWorkbook 
      WBObjectSize = .GetFile(wb.fullname).Size 
      MsgBox (Format(WBObjectSize, "#,##0") & " Bytes") 
    End With 
    End Sub 

ile benim bütün belgenin toplam boyutunu bulabilir ve ben levha tarafından boyutu ve burada

 Sub GetSheetSizes() 
     ' ZVI:2012-05-18 Excel VBA File Size by Worksheet in File 
     ' CAR:2014-10-07 Enhanced to take hidden and very hidden sheets into account 

     Dim a() As Variant 
     Dim Bytes As Double 
     Dim i As Long 
     Dim fileNameTmp As String 
     Dim wb As Workbook 
     Dim visState As Integer 

     Set wb = ActiveWorkbook 
     ReDim a(0 To wb.Sheets.Count, 1 To 2) 

     ' Turn off screen updating 
     Application.ScreenUpdating = False 
     On Error GoTo exit_ 

     ' Put names into a(,1) and sizes into a(,2) 
     With CreateObject("Scripting.FileSystemObject") 
      ' Build the temporary file name 
      Err.Clear 
      fileNameTmp = .GetSpecialFolder(2) & "\" & wb.Name & ".TMP" 
      ' Put workbook's name and size into a(0,) 
      a(0, 1) = wb.Name 
      a(0, 2) = .GetFile(wb.fullname).Size 
      ' Put each sheet name and its size into a(i,) 
      For i = 1 To wb.Sheets.Count 
      visState = wb.Sheets(i).Visible 
      wb.Sheets(i).Visible = -1 ' Show sheet long enough to copy it 
      DoEvents 
      wb.Sheets(i).Copy 

      ActiveWorkbook.SaveCopyAs fileNameTmp 

      wb.Sheets(i).Visible = visState 
      a(i, 1) = wb.Sheets(i).Name 
      a(i, 2) = .GetFile(fileNameTmp).Size 
      Bytes = Bytes + a(i, 2) 
      ActiveWorkbook.Close False 
      Next 
      Kill fileNameTmp 
     End With 

     ' Show workbook's name & size 
     Debug.Print a(0, 1), Format(a(0, 2), "#,##0") & " Bytes" 

     ' Show workbook object's size 
     Debug.Print "Wb Object", Format(a(0, 2) - Bytes, "#,##0") & " Bytes" 

     ' Show each sheet name and its size 
     For i = 1 To UBound(a) 
      Debug.Print a(i, 1), Format(a(i, 2), "#,##0") & " Bytes" 
     Next 

     exit_: 

     ' Restore screen updating 
     Application.ScreenUpdating = True 

    ' Show the reason of error if happened 
     If Err Then MsgBox Err.Description, vbCritical, "Error" 


    End Sub 

egzersizdir kullanarak WB Nesne keşfedebilirsiniz. Ben MyWorkbook

adım 1. onay toplam dosya boyutu ve dosya boyutu levha + wb nesne tarafından

 MYWORKBOOK Ver0.34 test.xlsm  932,450 Bytes Total 
     Wb Object  201,679 Bytes 
     Home   312,904 Bytes 
     NISI_DETAIL 40,815 Bytes 
     DATABASE  49,186 Bytes 
     Settings  13,690 Bytes 
     NISI_LIST  27,484 Bytes 
     PleaseWait 21,232 Bytes 
     success  22,077 Bytes 
     Brands  34,721 Bytes 
     USER_LIST  26,819 Bytes 
     QUERY_LIST 37,880 Bytes 
     CAT_MAN_TOOLS 88,406 Bytes 
     Sheet1  9,997 Bytes 
     PROMO_LIST 45,560 Bytes 

adım 2. sadece yeni bir boş sheet1 bırakarak TÜM YAPRAKLARİ SİL ve tekrar

kontrol ettirin

 MYWORKBOOK Ver0.34 test .xlsm  370,052 Bytes 
     Wb Object  361,589 Bytes 
     Sheet1  8,463 Bytes 

Evet, dosya boyutu azaldı, ancak her sayfayı sildim. Ancak, bu gizemli Wb Nesnesi aslında daha büyük var. Ne oluyor be??? tek bir boş levha ve bir 370Kb dosyadan başka bir şey ????? BTW'nin aynı testi yeni bir çalışma kitabında çalıştırması, Wb Nesne boyutunu 0 bayt olarak tanımlar.

TL; DR: Yukarıdaki örnekte yer alan Wb nesnesi nedir? Neden büyümeye devam ediyor? Onu 0 Bayt'a kadar nasıl azaltabilirim?

Answer 1

Dosya küçültme için kod kullanıyorum ama sizin durumunuza göre, ne yazdığınızı temel alarak yardımcı olacağını görmüyorum. GSGG önerisi başına zip dosyasının içeriğini görmeye çok hevesli olurdum. Bunu denemek isterseniz, işte

benim dosya azaltma kodudur ama dediğim gibi, ben bunu umuyor olduğunca küçük alacak görmüyorum ama denemeye değer: Büyük

Sub LipoSuction2() 
'Written by Daniel Donoghue 18/8/2009 
'The purpose of this code is to offer an alternative to the original Liposuction code written by JBeaucaire for the MrExcel forums www.mrexcel.com 
Dim ws As Worksheet 
Dim CurrentSheet As String 
Dim OldSheet As String 
Dim Col As Long 
Dim r As Long 
Dim BottomrRow As Long 
Dim EndCol As Long 
'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
Dim Pic As Object 
'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
For Each ws In Worksheets 
    ws.Activate 
    'Put the sheets in a variable to make it easy to go back and forth 
    CurrentSheet = ws.Name 
    'Rename the sheet to its name with TRMFAT at the end 
    OldSheet = CurrentSheet & "TRMFAT" 
    ws.Name = OldSheet 
    'Add a new sheet and call it the original sheets name 
    Sheets.Add 
    ActiveSheet.Name = CurrentSheet 
    Sheets(OldSheet).Activate 
    'Find the bottom cell of data on each column and find the further row 
    For Col = 1 To Columns.Count 'Find the REAL bottom row 
     If Cells(Rows.Count, Col).End(xlUp).Row > BottomRow Then 
      BottomRow = Cells(Rows.Count, Col).End(xlUp).Row 
     End If 
    Next 
    'Find the end cell of data on each row that has data and find the furthest one 
    For r = 1 To BottomRow 'Find the REAL most right column 
     If Cells(r, Columns.Count).End(xlToLeft).Column > EndCol Then 
      EndCol = Cells(r, Columns.Count).End(xlToLeft).Column 
     End If 
    Next 
    'Copy the REAL set of data 
    Range(Cells(1, 1), Cells(BottomRow, EndCol)).Copy 
    Sheets(CurrentSheet).Activate 
    'Paste everything 
    Range("A1").PasteSpecial xlPasteAll 
    'Paste Column Widths 
    Range("A1").PasteSpecial xlPasteColumnWidths 
    'Begin addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
    Sheets(OldSheet).Activate 
    For Each Pic In ActiveSheet.Pictures 
     Pic.Copy 
     Sheets(CurrentSheet).Paste 
     Sheets(CurrentSheet).Pictures(Pic.Index).Top = Pic.Top 
     Sheets(CurrentSheet).Pictures(Pic.Index).Left = Pic.Left 
    Next 
    Sheets(CurrentSheet).Activate 
    'End Addition 6/4/2010 for request: http://www.mrexcel.com/forum/showthread.php?p=2269274#post2269274 
    'Reset the variable for the next sheet 
    BottomRow = 0 
    EndCol = 0 
Next 
'Excel will automatically replace the sheet references for you on your formulas, the below part puts them back 
'This is done with a simple reaplce, replacing TRMFAT with nothing 
For Each ws In Worksheets 
    ws.Activate 
    Cells.Replace "TRMFAT", "" 
Next 
'Poll through the sheets and delete the original bloated sheets 
For Each ws In Worksheets 
    If Not Len(Replace(ws.Name, "TRMFAT", "")) = Len(ws.Name) Then 
     Application.DisplayAlerts = False 
     ws.Delete 
     Application.DisplayAlerts = True 
    End If 
Next 
End Sub