[[20130318142731]]　『図の圧縮をVBAで』（素敵な人）　ページの最後に飛ぶ

『図の圧縮をVBAで』（素敵な人）
画像を選択すると、図ツールバーから図の圧縮が出来るんですが、
これをマクロで動作させることは出来ないですか？
よろしくお願いします。

 その操作をマクロ記録してみたらいかが？
 （2007以外 なら記録されるはずなので）

 ↑　ごめん、撤回。　記録されないね、2010でも。

 追記　ざっとググってみたけど、この機能（エクセルが使っている機能）はエクセル固有のものじゃないので
 　　　マクロ記録されないんだねぇ・・・
 　　　SendKeys あたりで操作の動きをシミュレートさせるか・・・・・

 さらに追記）別の板だけど

http://www.moug.net/faq/viewtopic.php?t=64856

 　　　　　　圧縮以外の別の方法で切り抜けるか、あるいは専用のフリーソフトなんかを使うか
 　　　　　　そんな紹介があるね。

 (ぶらっと)

ありがとうございます。
それを参考に作ったのですが
Sub Macro1()

    ActiveSheet.Shapes.SelectAll
    Selection.Cut
    ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:= _
        False

End Sub

これを他のマクロの中に挿入したいのですがどうしたらいいでしょうか。

sub

end subu

end subu
のようにしたら動きませんでした。
（素敵な人）

 >end subu ???

 subu なんてのはないので　End Sub だけど？

 コードを挿入して動かなくなったという、そのコードをコピペしてアップしてくれるかな？

 (ぶらっと)

単純にsubとend subを消したら動きました。
ですが、複数枚の画像でやると貼り付けたときに1枚の画像になってしまうんですが
それはなんとかならないでしょうか？
（素敵な人）

 そちらのコード実態が見えないのでなんともねぇ・・・
 動かしているコードをコピペで、アップしてくれる？

 (ぶらっと)

 とりあえず推測で。

    ActiveSheet.Shapes.SelectAll
    Selection.Cut
    ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:= _
        False

 この部分を

    Dim sp As Shape
    Dim l As Double
    Dim t As Double
    For Each sp In ActiveSheet.Shapes
        l = sp.Left
        t = sp.Top
        sp.Select
        Selection.Cut
        ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
        DoEvents
        With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
            .Left = l
            .Top = t
        End With
    Next

 こんなようにしてみるとか。

 (ぶらっと)

Sub Macro1()

    ActiveSheet.Shapes.SelectAll
    Selection.Cut
    ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:= _
        False

End Sub

これです、これだと複数毎の画像が貼付けたら一枚の画像になってしまうのです。
（素敵な人）

出来ました、ありがとうございましたo(^o^)o

（素敵な人）

フォームでマクロを登録してるのですが、それもいっしょに切り取り貼付け
されて、ただの画像になってしまいました＞＜
どうしたらいいですか？
（素敵な人）

 対象にしている図が、どういうものか不安だけど、たとえば

    Dim sp As Shape
    Dim l As Double
    Dim t As Double
    For Each sp In ActiveSheet.Shapes
        If sp.Type = msoPicture Then
            l = sp.Left
            t = sp.Top
            sp.Select
            Selection.Cut
            ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
            DoEvents
            With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
                .Left = l
                .Top = t
            End With
        End If
    Next

 (ぶらっと)

出来ましたー(^o^)
ありがとうございました(~o~)

（素敵な人）

コメント返信：

[ 一覧(最新更新順) ]

[[20130318142731]] 『図の圧縮をVBAで』（素敵な人） ページの最後に飛ぶ

[[20130318142731]]　『図の圧縮をVBAで』（素敵な人）　ページの最後に飛ぶ