« 愛にあふれた数学教育書 | トップページ | アマゾンの購入履歴をエクセルマクロで、一括取得 »

エクセルのファイルサイズの縮小の方法。(画像がベタベタ貼ってるファイル編)

1.概要

『エクセルのファイルサイズ(ファイル容量)が、どうにも重くなって困った。』
ということが多く、なんとかサイズを小さく、縮小する方法を考えました。

この方法は、画像がたくさん貼ってあって、重いデータに有効な方法です。

 注(1) 一度「図の圧縮」をした後、さらに圧縮したい場合について提案します。
 注(2) 文字データや数式が多いことが原因で容量大のファイルでは、効果がありません。
 注(3) 「ブックの共有」により、ファイルサイズが巨大化した場合にも効果ありません。(この場合は、一旦共有をはずし、再度共有化する方法が有効です。)

 注(4) エクセルのバージョンは 2000~2003程度を想定しています。

 注(5) この提案はエクセルマクロ(VBA)を使用します
 注(6) 「図の圧縮」自体はマクロ化が不可能な様子なので、この部分の作業は「手作業」になります。

2.「図の圧縮」について

このやり方は、「図の圧縮」を行うやり方であり、
ここで紹介するのは、「図の圧縮」を、より強固に行うものです。

まず、その基本となる、「図の圧縮」については、以下の方法です。

エクセル>表示>ツールバー>図
で、出てくる 2 をクリックすることで以下が、表示されます。

1

ここで「ドキュメント内のすべての図」と解像度の「Web/画面 解像度:96dpi」を
選ぶことで、エクセルファイル内の画像ファイルの解像度が低減され、うまくすれば、ファイル容量を減らすことができます。

ただし、すでに圧縮済みの画像等であれば、本方法による圧縮はあまり望めません。

3.より「圧縮する」(=ファイルサイズを減らす)方法について

上述2の方法で、うまくいけばファイルサイズを減らすことができますが、
実際には、あまり減らないことの方が多いです。

なので、より一層減らす方法をここで紹介します。

手順としては以下のとおりです。

(1) マクロにより、エクセル中の画像を、すべて小さいサイズに変更する
(2) その小さいサイズの状態で、「図の圧縮」を実行する
(3) マクロにより、エクセル中の画像を、すべて元のサイズに変更する

4.実際にやってみる

実際にやってみると、以下のような形になります

(1)元ファイル・・・作業前 542KByte (処理前のデータです)
 「0改善前」をダウンロード

(2)「図の圧縮」後・・・542KByte (サイズは変わりませんでした)
 「1図の圧縮後」をダウンロード

(3)マクロ処理による図の縮小後・・・542KByte (サイズはまだ変わってません)
 「2縮小後」をダウンロード

(4)再度、「図の圧縮」後・・・97KByte (縮小したあとで圧縮し、サイズが劇的に減りました)
 「3再、図の圧縮後」をダウンロード

(5)マクロ処理により、サイズを復元します・・・97KByte (見た目も当初とほぼ同じです)
 「4サイズ復元後」をダウンロード

上記の手順により、画像を劣化させることにより、ファイルサイズの大幅な削減が可能です。

5.画像の縮小・拡大のマクロについて

全シートの、全画像を、一括処理にて、縮小/拡大するマクロは以下です

Const RITSU As Double = 1.5

Sub doDownSize()
    Dim sht As Variant
    Dim shps As Shape
    For Each sht In ActiveWorkbook.Sheets
        sht.Select
        For Each shps In ActiveSheet.Shapes
            Debug.Print shps.Name
    '        If Left(shps.Name, Len("Picture")) = "Picture" Then
            shps.Select
            Selection.ShapeRange.Width = Selection.ShapeRange.Width / RITSU
            Selection.ShapeRange.Height = Selection.ShapeRange.Height / RITSU
    '        End If
        Next
    Next
End Sub

Sub doUpSize()
    Dim sht As Variant
    Dim shps As Shape
    For Each sht In ActiveWorkbook.Sheets
        sht.Select
        For Each shps In ActiveSheet.Shapes
            Debug.Print shps.Name
    '        If Left(shps.Name, Len("Picture")) = "Picture" Then
            shps.Select
            Selection.ShapeRange.Width = Selection.ShapeRange.Width * RITSU
            Selection.ShapeRange.Height = Selection.ShapeRange.Height * RITSU
    '        End If
        Next
    Next
End Sub

 doDownSize()→「4.(3)マクロ処理による図の縮小」に相当

 doUpSize()→「4.(5)マクロ処理により、サイズを復元」

RITSUの数字は大きい値にするほど、「画像が粗くなり」「縮小率も上がり」ます。

通常は1.2~1.8程度を代入してください。

(1.5と入力すると、縮小時に1÷1.5=67%に縮小されるということです。)

 注(1) If Left(shps.Name~の文をコメントアウトしているので、すべてのシェイプについて、縮小拡大を行っています。これは、画像を含めグループ化を行っている際に、shps.Nameが、"Picture"ではなく"Group"等になり、縮小拡大対象とならないことへの措置です。(他のシェイプも縮小拡大されますが、図の圧縮により影響を受けないため、処理前後で内容は変わりません。)

 注(2) マクロの作成、実行方法は他をご参考ください。(簡単に言うと、①ALT+F11により編集画面を開き、②編集画面にマクロを貼り付け、③F5で実行です。)

6.データ一式

上記のエクセルファイル及び、マクロデータは以下で一式ダウンロードできます。

「_set.zip」をダウンロード

(「0改善前.xls」「3再、図の圧縮後.xls」「4サイズ復元後.xls」「マクロです.xls」の4ファイルが含まれています。)

7.おさらい

ここでは、画像ファイルを多数保持するエクセルファイルの、
サイズ削減方法
を提案しています。

基本「図の圧縮」を利用する方法ですが、マクロにより、全画像を一旦縮小表示して、その状態で「図の圧縮」をすることでより容量の削減率の高い、ファイルサイズ圧縮を実現するものです。

画像は、劣化されますが、ファイルサイズを減らすことが可能になります。

以上

============================

8.補足

ちなみに、「図の圧縮」を利用せずに、画像のカット&ペーストにより、画像を圧縮する方法もありえます。

「other_sample.xls」をダウンロード

この方法であれば、

メリット: 全自動
 (すべてマクロで実行でき、「図の圧縮」のようにダイアログへのクリックが無い。)

という良さがあります。

反対に

デメリット1:○や□や△といった図形のオートシェイプと、写真などの画像を混在させていた場合に注意が必要。
(①図形のオートシェイプを画像として貼ると透過性などが失われるため、場合分けが必要です。②画像を切り貼りするで、前面背面が入れ替わります。背面に送る処理は可能ですが、画像同士の前面背面関係にも配慮が必要です。③また、グループ化を行っている場合の適用も複雑になるため、一旦グループ化の解除等が必要になります。) 

デメリット2:JPEG画像とPNG画像の適用を誤ると、かえってファイル容量が増えてしまう。
(写真画像の場合はJPEG形式、WEB画面などの図形画像であればPNG形式というように、形式を使い分ける必要があります。)

といった、使用上の難しさがあります。

Sub doDownUPSize2()
    Dim sht As Variant
    Dim shps As Shape
    Dim x As Double
    Dim y As Double
    Dim sw As Double
    Dim sh As Double
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Call UngroupAll
    For Each sht In ActiveWorkbook.Sheets
        If sht.Visible = xlSheetVisible Then
        sht.Select
        For Each shps In ActiveSheet.Shapes
            Debug.Print shps.Name
            If Left(shps.Name, Len("Picture")) = "Picture" Then
                shps.Select
                x = shps.Left
                y = shps.Top
                sw = Selection.ShapeRange.Width
                sh = Selection.ShapeRange.Height
                Selection.Cut
                'ActiveSheet.Paste
                ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, DisplayAsIcon:=False
                'ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
                Selection.ShapeRange.Width = sw
                Selection.ShapeRange.Height = sh
                Selection.Left = x
                Selection.Top = y
            Else
                If Left(shps.Name, Len("Drop Down")) = "Drop Down" Then
                Else
                    shps.Select
                    Selection.ShapeRange.ZOrder msoBringToFront
                End If
            End If
        Next
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub UngroupAll()
    For Each sht In ActiveWorkbook.Sheets
        If sht.Visible = xlSheetVisible Then
        sht.Select
label1:
        For Each shps In ActiveSheet.Shapes
        If Left(shps.Name, Len("Group")) = "Group" Then
            shps.Select
            Selection.ShapeRange.Ungroup.Select
            GoTo label1
        End If
        Next
        End If
    Next
End Sub


|

« 愛にあふれた数学教育書 | トップページ | アマゾンの購入履歴をエクセルマクロで、一括取得 »

コメント

一度圧縮、サイズ変更して劣化した画像をもとに戻す方法があったら教えてください。

投稿: takeo.yaguchi | 2014年11月 6日 (木) 13時38分

圧縮して、サイズが小さくなったときですよね。その場合は、不可逆で、たぶん劣化したものを戻す方法はないと思います。劣化無く(あるいは劣化をできるだけ少なく)画像を縮小するツール等は、フリーソフトであるので(例「縮小専用」)それらを利用した方が良いと思います。

投稿: 管理人 | 2014年11月 6日 (木) 23時38分

コメントを書く



(ウェブ上には掲載しません)


コメントは記事投稿者が公開するまで表示されません。



トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/169199/45170500

この記事へのトラックバック一覧です: エクセルのファイルサイズの縮小の方法。(画像がベタベタ貼ってるファイル編):

« 愛にあふれた数学教育書 | トップページ | アマゾンの購入履歴をエクセルマクロで、一括取得 »