エクセラのEXCEL
表計算ソフトEXCELでゲーム等を作っています。ゲーム等の作成状況を紹介。
ダイエット

グラフィックエディター等から、画像をコピーし、それをエクセルへ貼り付けると、ビットマップ形式で貼りつくため、ファイル容量が膨大となる。そこで、貼り付けた画像をJPEGにするマクロを作ってみた。
コードを実行すると、対象ファイルを選択し、ブック内の貼り付けた画像を、JPEGに変更し、ファイル名に(diet)をつけて保存します。
なお、グループ化した画像は対象外となります。JPEG形式からGIF形式にする場合は、コードの
ActiveSheet.PasteSpecial Format:="図 (JPEG)"

ActiveSheet.PasteSpecial Format:="図 (GIF)"
に変更するだけ。


Sub test()
    fn = Application.GetOpenFilename("ファイル (*.xls),*.xls", , "対象のファイルを開いてください")
    Application.ScreenUpdating = False
    If fn <> False Then
        Workbooks.Open Filename:=fn
        For Each ws In ActiveWorkbook.Sheets
            Sheets(ws.Name).Select
            For Each ss In ActiveSheet.Shapes
                If InStr(ss.Name, "Object") Then
                    ActiveSheet.Shapes(ss.Name).Select
                    x = Selection.ShapeRange.Left
                    y = Selection.ShapeRange.Top
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.Cut
                    ActiveSheet.PasteSpecial Format:="図 (JPEG)"
                    Selection.ShapeRange.Left = x + 10
                    Selection.ShapeRange.Top = y + 10
                End If
            Next
        Next
        ff = Mid(fn, InStrRev(fn, "\") + 1): ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls"
        ActiveWorkbook.SaveAs Filename:=Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls"
        Windows(ff).Close
    End If
    Application.ScreenUpdating = True
End Sub


コードの入力が大変な方は、*HP*の右下のpic_dietをダウンロードして下さい。

スポンサーサイト

テーマ:EXCEL - ジャンル:コンピュータ

コメント
この記事へのコメント
コメントを投稿する
URL:
Comment:
Pass:
秘密: 管理者にだけ表示を許可する
 
トラックバック
この記事のトラックバックURL
この記事へのトラックバック
copyright © 2005 エクセラのEXCEL all rights reserved.
Powered by FC2ブログ.