Excel VBA質問箱 IV

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

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


7735 / 13645 ツリー ←次へ | 前へ→

【37174】図の圧縮 EEK 06/4/25(火) 9:35 質問[未読]
【37175】Re:図の圧縮 neptune 06/4/25(火) 9:59 発言[未読]
【37177】Re:図の圧縮 EEK 06/4/25(火) 10:27 質問[未読]
【37186】Re:図の圧縮 neptune 06/4/25(火) 13:49 発言[未読]
【37190】Re:図の圧縮 Kein 06/4/25(火) 14:48 回答[未読]

【37174】図の圧縮
質問  EEK  - 06/4/25(火) 9:35 -

引用なし
パスワード
   1ページに3枚の写真を挿入(自動で縮小すようにマクロを組んでいます)できる
ようなものを作っていますが、1シートが10ページなので、写真が30枚貼り付けるとファイルが重くなって困っています。
[図の書式設定]−[図の圧縮]−[設定の対象、解像度の変更、オプション]
の変更をマクロで組みたいのですがどうすればよいのでしょうか?
解る方教えて下さい。

【37175】Re:図の圧縮
発言  neptune  - 06/4/25(火) 9:59 -

引用なし
パスワード
   ▼EEK さん:
>の変更をマクロで組みたいのですがどうすればよいのでしょうか?
>解る方教えて下さい。
解る方ではないですが、「どうすればよい」程度は
マクロの記録でできませんか?

【37177】Re:図の圧縮
質問  EEK  - 06/4/25(火) 10:27 -

引用なし
パスワード
   ▼neptune さん:
ありがとうございます。
>マクロの記録でやってみたのですが、下記の通りで、

   ActiveSheet.Shapes("Picture 270").Select
  Selection.ShapeRange.PictureFormat.Brightness = 0.5
  Selection.ShapeRange.PictureFormat.Contrast = 0.5
  Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
  Selection.ShapeRange.PictureFormat.CropLeft = 0#
  Selection.ShapeRange.PictureFormat.CropRight = 0#
  Selection.ShapeRange.PictureFormat.CropTop = 0#
  Selection.ShapeRange.PictureFormat.CropBottom = 0#

図(写真)の圧縮になっていませんでした。
貼り付けた図(写真)の圧縮(解像度の変更)をしたいのですが・・・

【37186】Re:図の圧縮
発言  neptune  - 06/4/25(火) 13:49 -

引用なし
パスワード
   ▼EEK さん:
つかぬ質問ですが、
>[図の書式設定]−[図の圧縮]−[設定の対象、解像度の変更、オプション]
>の変更をマクロで組みたいのですがどうすればよいのでしょうか?
というコマンドはExcelにあるんですか?

当方Excel2000なのでありません。最近のバージョンで出来たのかと思いました。

>図(写真)の圧縮になっていませんでした。
>貼り付けた図(写真)の圧縮(解像度の変更)をしたいのですが・・・
もし、無いのなら、基本的にはExcelの機能では出来ません。
1.Excelでのトリッキーな手法を使うか、
2.VBAでプログラムを書くかの方法
になると思います。

1.はチャートオブジェクトを使えば出来ると思いますが、やったことありません。
2.は画像ファイルの種類にもよりますが、技術的に難しいです。

【37190】Re:図の圧縮
回答  Kein  - 06/4/25(火) 14:48 -

引用なし
パスワード
   これで少しぐらいは圧縮できませんか ?

Sub MyPic_Compression()
  Dim Pic As Object

  For Each Pic In ActiveSheet.Pictures
   With Pic
     .ShapeRange.LockAspectRatio = True
     .Cut
     .Parent.PasteSpecial Format:="Jpeg"
   End With
   Application.CutCopyMode = False
  Next
End Sub

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