Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


15027 / 76738 ←次へ | 前へ→

【67196】ブックのサイズを縮小する
質問  Abebobo  - 10/11/15(月) 10:30 -

引用なし
パスワード
   質問させてください。

最近、デジカメや記録媒体の性能がどんどん上がってきています。
それに伴い、写真のサイズを気にせずにエクセルブックにべたべた貼り付ける人もどんどん増えていきます。で、『サーバーが一杯になっちゃんですけど〜』って言われます。 見てみるとエクセルブックが、21MBを最大に5MBクラスがうじゃうじゃいます。

Sub 写真軽量()

Dim ShP As Object
Dim New_ShP As Object
Dim ShP_top As Double
Dim ShP_left As Double
Dim Tar_WB As Workbook

Set Tar_WB = ActiveWorkbook

With Tar_WB

 For Each ShP In .ActiveSheet.Shapes
  If ShP.Type = 13 Then
   Debug.Print ShP.Type
 '  ShP.Select
 '  Stop
   ShP_top = ShP.Top
   ShP_left = ShP.Left
   ShP.CopyPicture Appearance:=xlScreen, Format:=xlPicture
   ShP.TopLeftCell.Select
   Set New_ShP = ActiveSheet.Pictures.Paste
   New_ShP.Top = ShP.Top
   New_ShP.Left = ShP.Left
   ShP.Delete
  End If
 
 Next
End With


End Sub

こんなの造って見ましたけど、もっとかっこよいコードのアドバイスをお願いします。

図のコピー⇒貼り付け⇒図の微調整⇒オリジナル図の削除
のコードです。

0 hits

【67196】ブックのサイズを縮小する Abebobo 10/11/15(月) 10:30 質問
【67200】Re:ブックのサイズを縮小する Jaka 10/11/15(月) 11:52 発言
【67201】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 12:13 お礼
【67205】Re:ブックのサイズを縮小する Jaka 10/11/15(月) 14:15 発言
【67207】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 20:42 お礼
【67219】間違い修正 Jaka 10/11/16(火) 9:29 発言
【67222】Re:間違い修正 Abebobo 10/11/16(火) 10:03 発言
【67221】Re:ブックのサイズを縮小する Abebobo 10/11/16(火) 10:00 お礼
【67246】Re:ブックのサイズを縮小する Jaka 10/11/17(水) 13:38 発言
【67257】Re:ブックのサイズを縮小する Abebobo 10/11/17(水) 18:17 お礼
【67210】Re:ブックのサイズを縮小する kanabun 10/11/15(月) 22:31 発言
【67211】Re:ブックのサイズを縮小する Abebobo 10/11/15(月) 22:53 お礼
【67236】Re:ブックのサイズを縮小する ichinose 10/11/17(水) 7:11 発言
【67238】Re:ブックのサイズを縮小する Abebobo 10/11/17(水) 9:48 お礼

15027 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free