【初月無料キャンペーン中】gooドクター

画像を貼り付けた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

gooドクター

A 回答 (1件)

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


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

1時間に100ファイル処理すれば何時間かで終わります。
1日に1時間ほどやれば3日で300ファイル終わります。
<方法>
ファイルを10個ほど開いておき、以下を10回分繰り返します 
ファイル⇒ オプション ⇒ 詳細設定 
 → 解像度(150、96 などを選択) → 項目確認 → 上書き保存
    • good
    • 0
この回答へのお礼

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング