xlsのダイエット

お気づきの方も少なくないと思いますが、excelやword（マイクロソフト製品）においてクリップボードを経由した画像貼り付け、OLEとかActiveXというのでしょうか？自分は日曜プログラマー50歩手前なので詳しいこと知りませんが・・
おっと、話逸れ気味。
要はexcelにクリップボードから何の意識もなしに他のアプリケーションから貼り付けた画像ってビットマップ形式のデータらしく、それはそれは大きなxlsファイルになってしまうんです。
「そうなの？」と思う人や、「嘘でぇ～」と思う人は試して見るべし。
20倍以上の差が出るはず。
試し方は、excelを起動して、メニューから「挿入-図-ファイルから」を選び写真を貼り付ける。==>保存（ファイル1とする）
同じ写真をペイントなどで開いてコピーを行い、新しいworkbookに「右クリック-貼り付け」で貼り付ける==>保存（ファイル2とする）
上記方法で作成したファイルは少なくともサイズが違うはず。たぶん大きく・・

ね！っね！結構違うものでしょう？？
こんな困ったファイルがいっぱいになってしまうと困るんですよね、いくらストレージデバイスが値下がりしても。
結局行き着くところは使う人間の工夫で道具たるPCなんてどうにでもなるのです。
さて、この肥大化してしまったデブxlsファイルを小さくする方法はないのか、考えました。
大きくなってしまっている原因がおそらくbitmapになってしまっているのだろうと察しがついたので、【形式を選択して貼り付け】に目を付けました。
画像を選択し、切り取り、そしてそのまま形式を選択して貼り付けにおいて【図 （JPEG）】を選択して貼り付ける。
こうしてやると確かに小さくなる。（ちょっとなりすぎるくらいだ-後述-）
このファイルダイエットに気がついてしまった自分はコツコツと無粋なxlsファイル達をいじめはじめた。
ん～なんと心地よいのか。。[:ぽっ:]
とまぁそんなのは初めのうちだけで、10MBをえてしまっているxlsファイルを検索してみると結構あり、その内の一つを開いてみると仰天。
顔写真がずらりと並んでおり、そんなシートが十枚以上。ハァ、そりゃ重いでしょうよ・・・
こんなのどれがbitmapで入ってしまっているかも解らないのに、一つ一つ張り直すのかよ～～（涙
という状況に陥ったのです。（既に物語風…
転勤話も出るくらい余裕な勤務状況の自分はこのような状況に対応すべく、シート状のPictureオブジェクトを片っ端から見境無くJpeg形式で貼り付け直すマクロを作為してしまいました。
写真を明確に明示するために枠線を入れていることも少なくないので、枠線を一度消して切り取り、Jpegで貼り付けてから枠線復活という丁寧な手法でxlsをダイエットさせるマクロです。（なんてエレガント）
コードは無粋かもしれないけど、その辺はご容赦を。それと、『それはまずいでしょー』と思ってしまった方は詳しく詳しくその内容を教えていただけるととても助かります。むしろそのような報告をお待ちしています。
で以下、コード。

Public Sub bmp2jpg()
On Error GoTo Error_msg
Dim s As Shape
Dim tl As String
Dim mg As String
Dim no As Integer
no = 0
For Each s In Application.ActiveSheet.Shapes
If s.Type = msoPicture Then ‘画像だけ見つけて
tl = s.TopLeftCell.Address
Application.ActiveSheet.Shapes(s.Name).Select ‘状態の保存（プロパティーコピー
Application.Selection.ShapeRange.PickUp
s.Line.Visible = msoFalse ‘枠を非表示
s.Select
Application.Selection.Cut
Application.ActiveSheet.Range(tl).Select
Application.ActiveSheet.PasteSpecial Format:=”図 (JPEG)”, Link:=False, DisplayAsIcon:=False
Application.Selection.ShapeRange.Apply ‘状態の復元（プロパティーコピー
no = no + 1
End If
Next
If no Then
mg = no & “枚の画像を全部置き換えました。” & Chr(13) & “もう戻せません。”
Else
mg = “画像が見つかりませんでした。”
End If
MsgBox mg ‘さよならの挨拶
Exit Sub
Error_msg:
MsgBox “プログラムに問題があるため、このシートで対応できません” & Chr(13) & “ごめんなさい.” _
& Chr(13) & Chr(13) & “Subプロシージャ名：bmp2jpg”
On Error GoTo 0
End Sub

使用上の注意点としては、Office2003からかな？「図の圧縮」というコマンドボタンが増えましたが、そのボタンでいう【Web/画面】という張り切ってサイズを落としてしまう設定くらい小さくなるので、「綺麗に印刷したいのだ」とお思いの方はちょっと注意を払って一度実験をしてから使用することをお勧めします。
それと、もしかしたら見た目のままで切り取られるような場合、画面の表示倍率によってサイズが変わってくる可能性があると思っています。
何かというと、画面に200%で表示している状態と、50%表示の状態で実行するので結果が違うのではないか？ということ。
後で実験してみます。
ああ、それと、さすがにこんなコードをいちいちworkbookにコピペして使うのは非常に無駄なので、数日の内にアドイン化する予定です。
配布したら売れるかなぁ？（有料じゃないよ