什么进入Excel工作簿对象，增加文件大小？
我正在尝试减less我正在使用的Excel工作簿的文件大小。 我已经知道未使用的行是一个问题和不必要的图像等。神秘的是为什么只有似乎增长的Excel的秘密部分？
我可以发现整个文档的总大小
Sub workbook_objectsize() With CreateObject("Scripting.FileSystemObject") Set wb = ActiveWorkbook WBObjectSize = .GetFile(wb.fullname).Size MsgBox (Format(WBObjectSize, "#,##0") & " Bytes") End With End Sub 我可以通过表单和WB对象使用来发现大小
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
这是练习。 我有MYWORKBOOK
步骤1.通过工作表+ wb对象检查总文件大小和文件大小
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
步骤2.删除所有页面只留下新的空白页面1，然后再次检查
MYWORKBOOK Ver0.34 test .xlsm 370,052 Bytes Wb Object 361,589 Bytes Sheet1 8,463 Bytes
是的文件大小减less了，但那是因为我删除了每张纸。 但是，这个神秘的Wb对象实际上变大了。 我勒个去？？？ 只有一张空白纸和一个370Kb的文件 顺便说一句，在一个新的工作簿上运行这个相同的testingyeilds Wb对象大小为0字节。
TL; DR：上面例子中的Wb对象究竟是什么？ 为什么它不断增长？ 我怎样才能减less到0字节？
为了减less文件，我使用代码，但在你的情况下，我不认为这将有助于根据你发布的内容。 我会非常希望看到每个GSergsbuild议的zip文件的内容。
这是我的文件缩减代码，如果你想尝试，但就像我说的，我没有看到它会得到它像你希望的那么小，但值得一试：
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