|
|
| 1 | 2 | 3 | 4 |
5 | 6 | 7 | 8 | 9 | 10 | 11 |
12 | 13 | 14 | 15 | 16 | 17 | 18 |
19 | 20 | 21 | 22 | 23 | 24 | 25 |
26 | 27 | 28 | 29 | 30 | 31 | |
|
|
|
|
|
|
|
|
Compress pictures in Excel files
Lots of excel files with uncompressed pictures were stored in the server. I wanted to compress them to 200dpi using VBA code. Here is the code I wrote. The code goes into all sub-folders looking for xls files and tries to compress them using standard Ecel function. I was able to reduce the space requirement by half.
Sub ListMyFiles(mySourcePath) Dim myObject As Object Dim mySource As Object Dim myFile Dim mySubFolder As Object Dim octl As CommandBarControl Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim appExcel As Excel.Application Set myObject = New FileSystemObject Set mySource = myObject.GetFolder(mySourcePath) On Error Resume Next
myFile = Dir(mySourcePath & "*.xls") Do While Len(myFile) myFile = CStr(mySourcePath & "" & myFile) If FileLen(myFile) > 1000000 Then If rsData.EOF Then Set appExcel = New Excel.Application Set wkb = appExcel.Workbooks(myFile) Set octl = appExcel.CommandBars.FindControl(ID:=6382) appExcel.SendKeys "%p" appExcel.SendKeys "%a" appExcel.SendKeys "{ENTER}" appExcel.Visible = True octl.Execute wkb.Save wkb.Close appExcel.Quit End If End If myFile = Dir() Loop For Each mySubFolder In mySource.SubFolders Me.Repaint Call ListMyFiles(mySubFolder.Path) Next End Sub
Create Date : 16 ธันวาคม 2553 |
|
0 comments |
Last Update : 25 สิงหาคม 2554 12:56:40 น. |
Counter : 1312 Pageviews. |
|
|
|
|
| |
|
|