Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7735 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【37174】図の圧縮 ＥＥＫ 06/4/25(火) 9:35 質問[未読]
【37175】Re:図の圧縮 neptune 06/4/25(火) 9:59 発言[未読]
【37177】Re:図の圧縮 ＥＥＫ 06/4/25(火) 10:27 質問[未読]
【37186】Re:図の圧縮 neptune 06/4/25(火) 13:49 発言[未読]
【37190】Re:図の圧縮 Kein 06/4/25(火) 14:48 回答[未読]
【37174】図の圧縮
質問  ＥＥＫ  - 06/4/25(火) 9:35 -
引用なし
パスワード
   １ページに３枚の写真を挿入（自動で縮小すようにマクロを組んでいます）できる
ようなものを作っていますが、１シートが１０ページなので、写真が３０枚貼り付けるとファイルが重くなって困っています。
[図の書式設定]−[図の圧縮]−[設定の対象、解像度の変更、オプション]
の変更をマクロで組みたいのですがどうすればよいのでしょうか？
解る方教えて下さい。
【37175】Re:図の圧縮
発言  neptune  - 06/4/25(火) 9:59 -
引用なし
パスワード
   ▼ＥＥＫ さん：
>の変更をマクロで組みたいのですがどうすればよいのでしょうか？
>解る方教えて下さい。
解る方ではないですが、「どうすればよい」程度は
マクロの記録でできませんか？
【37177】Re:図の圧縮
質問  ＥＥＫ  - 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 -
引用なし
パスワード
   ▼ＥＥＫ さん：
つかぬ質問ですが、
>[図の書式設定]−[図の圧縮]−[設定の対象、解像度の変更、オプション]
>の変更をマクロで組みたいのですがどうすればよいのでしょうか？
というコマンドはExcelにあるんですか？

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

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

１．はチャートオブジェクトを使えば出来ると思いますが、やったことありません。
２．は画像ファイルの種類にもよりますが、技術的に難しいです。
【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