Excelに貼り付けた画像を圧縮するマクロについて

画像を貼り付けたexcel ブックが何百個あります、印刷した時に画像が重くて、貼った画像が印刷できなかったりしますので、ブックに貼った画像を圧縮してブック保存することにしました。
excelブックを一つずつ開いて図を圧縮し保存するのが手間なので、マクロでできないかと、探してみたんですが、なかなか見つかれない。
ファイル開いて保存し閉じるマクロ見つけたんですが、画像の圧縮部分をどのように書けばいいのか
わからなくて、皆さんに助けを求め質問させていただきました。
excelに貼った画像枠の大きさはばらばらです、サイズを指定せずに、図形だけ圧縮、トリムしたいです。
マクロで圧縮トリムできるなら、画像の圧縮部分をどのように書けばいいのか教えてください。
よろしくお願いします。
下のマクロがファイル開いて保存し閉じるマクロです。
Private Sub CommandButton1_Click()
' フォルダ参照ダイアログを利用して、フォルダを特定する。
Dim folderName As Variant
Set folderName = CreateObject("Shell.Application") _
.BrowseForFolder( _
&O0 _
, "フォルダ選択" _
, &H1 + &H10 _
, "ﾃﾞｽｸﾄｯﾌﾟ")

' フォルダが選択されたか否か判別する。
If folderName Is Nothing Then
MsgBox "中止します"
Exit Sub
End If

' 単純なループカウンタ
Dim lp1 As Long, lp2 As Long
' FileSystemObjectを作成する。
Dim Obj As Object
Set Obj = CreateObject("Scripting.FilesystemObject")

' 選択されたフォルダ配下に存在するファイル名を取出す為の変数
Dim fileName As String
Dim fileNames() As String
ReDim fileNames(0) As String

' 選択されたフォルダ配下に存在するファイル名を取出す
fileName = Dir(folderName.Self.Path & "\*.xls")
Do While fileName <> vbNullString
' ファイル名を配列に取込む。
ReDim Preserve fileNames(UBound(fileNames) + 1) As String
fileNames(UBound(fileNames)) = _
folderName.Self.Path & "\" & fileName
fileName = Dir()
Loop

' 全てのExcelファイルを順次開いて閉じる。
For lp1 = 1 To UBound(fileNames)

' 開いたファイルのブック名を取得する。
Dim bookName As String
bookName = Obj.GetFileName(fileNames(lp1))

' 開いたファイルの全シートを全て参照する。
For lp2 = 1 To Workbooks(bookName).Sheets.Count
' ***************
' 集計処理を行う
' ***************
Next

' 開いていたExcelファイルを保存して閉じる。
Workbooks(bookName).Close SaveChanges:=False
Next

' メモリを解放する。
Erase fileNames

' オブジェクトを破棄する。
Set Obj = Nothing
Set folderName = Nothing
End Sub

No.1 回答者： DreamyCat 回答日時： 2015/04/11 10:32

VBAが趣味ならもうちょっと頑張ってみればいいだけですが

お仕事のようですから、手作業でさっさとやってしまったほうがいいでしょう。

１時間に１００ファイル処理すれば何時間かで終わります。
１日に１時間ほどやれば３日で３００ファイル終わります。
＜方法＞
ファイルを１０個ほど開いておき、以下を１０回分繰り返します　
ファイル⇒　オプション　⇒　詳細設定　
　→　解像度（１５０、96 などを選択）　→　項目確認　→　上書き保存

この回答へのお礼

回答ありがとうございました。確かに、手作業でやっても終わる仕事ですが、vbaでやりたくてがんばってみました。
理由はよくわかりませんが、”FileFormat:=xlExcel8　”この文追加することで圧縮保存できました。

お礼日時：2015/04/13 12:03