[[20060917194617]]　『画像のトリミング』（えりぐり）　ページの最後に飛ぶ

『画像のトリミング』（えりぐり）

シートに写真を挿入して必要ない部分はトリミングという作業をする。
このトリミング作業のときに、オートシェイプ（四角）の枠線と同じサイズにするマクロというのは出来ないでしょうか？どなたかお返事よろしくお願い致します。

エクセルのバージョン　Excel200
OSのバージョン　WindowsXP

 オブジェクト名は実際の名前に変更してください。
Sub Test()
Dim myPic As Shape, myShape As Shape
Dim dbl_mypicW As Double, dbl_mypicH As Double
Dim dbl_myShapeW As Double, dbl_myShapeH As Double
Set myPic = ActiveSheet.Shapes("Picture 1")
dbl_mypicW = myPic.Width        '写真の幅
dbl_mypicH = myPic.Height       '写真の高さ
Set myShape = ActiveSheet.Shapes("四角形 1")
dbl_myShapeW = myShape.Width    '四角形の幅
dbl_myShapeH = myShape.Height   '四角形の高さ
dbl_CropRight = (dbl_mypicW - dbl_myShapeW) / 2
dbl_CropLeft = dbl_CropRight
dbl_CropTop = (dbl_mypicH - dbl_myShapeH) / 2
dbl_CropBottom = dbl_CropTop
With myPic
    .PictureFormat.CropRight = dbl_CropRight
    .PictureFormat.CropLeft = dbl_CropLeft
    .PictureFormat.CropTop = dbl_CropTop
    .PictureFormat.CropBottom = dbl_CropBottom
End With
Set myPic = Nothing
Set myShape = Nothing
End Sub

 （川野鮎太郎）

早速、お返事ありがとうございました。

やってみると、なぜか　実行時エラー　'-2147024809 (80070057)

指定したアイテムがみつかりませんでした　

となってしまいます。

マクロ初心者なので、ご教授お願い致します。

（えりぐり）

 横から失礼します。
 ↓では？
 >Set myPic = ActiveSheet.Shapes("Picture 1")
 "Picture 1"を実際のシェイプ名に変えて試行してみてください。
 (MARBIN)

だめです・・・

実際のシェイプ名とは？

すみません、よろしくお願いします。

（えりぐり）

 >実際のシェイプ名とは？

 シェイプをクリックして名前ボックス
 に表示される名前のことです。
 (MARBIN)

 MARBINさん、フォローありがとうござます。
 シートの中のオブジェクトを指定しながらトリミングできるようにしてみました。
http://skyblue123.hp.infoseek.co.jp/Excel/trimming.xls

 （川野鮎太郎）

ありがとうございます。(MARBIN)さん（川野鮎太郎）さんのおかげでできました。

さらにで申し訳ないのですが、上記のマクロでは画像の真ん中しか切り取れませんが、

こういう流れでマクロは出来ないでしょうか？

画像挿入（ダイアログ）
→
任意の四角形をその写真の欲しいところに移動する
→
マクロを実行し、選択した部分だけが画像が残る

この繰り返しという感じで。

お願いばかりで、申し訳ありません。

仕事上、顕微鏡でみたものをデジカメでとり、その写真をエクセルに貼る作業をしているのですが、エクセルに挿入した画像を拡大縮小すると、プリントアウトする時に写真の倍率が変わってしまうので、この作業が必要なのです。どうぞ、よろしくお願いします。

（えりぐり）

 本来であれば、元の写真を画像処理ソフトでトリミングしたものを
 貼り付けたほうが良いと思います。
 エクセルのトリミングは、画面上だけのトリミングなので、
 ファイルサイズは元のままで大きいはずです。

 以下のコードは、元の写真をエクセル上でサイズ調整したものはうまくいきません。
Sub Test1()
Dim myPic As Shape, myShape As Shape
Dim dbl_mypicL As Double, dbl_mypicT As Double
Dim dbl_mypicW As Double, Dobdbl_mypicH As Double
Dim dbl_myShapeL As Double, dbl_myShapeT As Double
Dim dbl_myShapeW As Double, dbl_myShapeH As Double
Set myPic = ActiveSheet.Shapes("図 1")
dbl_mypicL = myPic.Left         '写真の左位置
dbl_mypicT = myPic.Top          '写真の上位置
dbl_mypicW = myPic.Width        '写真の幅
dbl_mypicH = myPic.Height       '写真の高さ
Set myShape = ActiveSheet.Shapes("四角形 1")
dbl_myShapeL = myShape.Left     '四角形の左位置
dbl_myShapeT = myShape.Top      '四角形の上位置
dbl_myShapeW = myShape.Width    '四角形の幅
dbl_myShapeH = myShape.Height   '四角形の高さ
dbl_CropLeft = dbl_myShapeL - dbl_mypicL         '左の調整値
dbl_CropTop = dbl_myShapeT - dbl_mypicT          '上の調整値
dbl_CropRight = (dbl_mypicW - dbl_myShapeW) - dbl_CropLeft
dbl_CropBottom = (dbl_mypicH - dbl_myShapeH) - dbl_CropTop
With myPic.PictureFormat
    .CropLeft = dbl_CropLeft       '左の調整
    .CropTop = dbl_CropTop         '上の調整
    .CropRight = dbl_CropRight     '右の調整
    .CropBottom = dbl_CropBottom   '下の調整
End With
Set myPic = Nothing
Set myShape = Nothing
End Sub

 （川野鮎太郎）

 次のことを確認しましたのでご報告致します。
 (何かのお役に立てれば良いのですが)

 １．新規ブック(シート数３)に、『画像のトリミング』（えりぐり）
 　　と名前を付けて保存・・・・・・ 14KB
 ２．123KB の画像を挿入・・・・・・137KB
 ３．画像を約1/4にトリミング ・・・137KB
 ４．「図の書式設定」の[図]タブより[圧縮(M)]

   図の圧縮
     設定の対象－－－－－
         ●選択した図(S)
         ○ドキュメント内のすべての図(A)
     解像度の変更－－－－
         ○Web/画面(W)
         ○印刷(P)
         ●変更なし(N)
     オプション
         □図の圧縮(C)
         ■図のトリミング部分の削除(E)

   上記条件で図の圧縮を実行・・・ 32KB

 どうしても、画像データで重くなったなら
 「図の圧縮」を行えばいいようですが・・・。
 どうしてもエクセルでやらなければいけないのでなければ
 必要な部分だけにした状態でエクセルに持ってきた方が
 やっぱり良いような気がします。

 鮎太郎さん(名指しでごめんなさい)
 図の圧縮の作業もVBAで設定出来たりしますか？
 直接「トリミング範囲」の所に値が入れられるから(cm単位ですが)
 VBAでやった方が簡単に出来ますかね？
 (手作業でやるときは、画像を見ながらトリミングして、図の書式設定の
  「トリミング範囲」には、その時の(↑で狭めた)範囲の数字が入っているので
  一度０になおしてから圧縮を実行します。)

 でも、これって案外需要がありそうですよね。
 画像管理をエクセルでやりたい人って結構いるみたいですから。
 (あれ？そんなに居ないですかね。)

 (HANA)

 HANAさん、検証ありがとうございます。
 画像管理をエクセルでやりたい人は結構いると思います。
 ただ、Excel2000には図の圧縮ってのが無いのです・・・＿/￣|○ il||li

 HANAさんのは2002以降でしょうか。

 （川野鮎太郎）

 写真の名前に一々変更することをやめて、選択した写真を変更するようにしました。
Sub Test1()
Dim myPic As Shape, myShape As Shape
Dim dbl_mypicL As Double, dbl_mypicT As Double
Dim dbl_mypicW As Double, dbl_mypicH As Double
Dim dbl_myShapeL As Double, dbl_myShapeT As Double
Dim dbl_myShapeW As Double, dbl_myShapeH As Double
Dim dbl_CropLeft As Double, dbl_CropTop As Double
Dim dbl_CropRight As Double, dbl_CropBottom As Double
Dim myPicture As String
On Error Resume Next
myPicture = Selection.ShapeRange.Name
If Err.Number <> 0 Then _
    MsgBox ("トリミングする写真を選択してください。"): Exit Sub
On Error GoTo 0
Set myPic = ActiveSheet.Shapes(myPicture)
dbl_mypicL = myPic.Left         '写真の左位置
dbl_mypicT = myPic.Top          '写真の上位置
dbl_mypicW = myPic.Width        '写真の幅
dbl_mypicH = myPic.Height       '写真の高さ
Set myShape = ActiveSheet.Shapes("四角形 1")
dbl_myShapeL = myShape.Left     '四角形の左位置
dbl_myShapeT = myShape.Top      '四角形の上位置
dbl_myShapeW = myShape.Width    '四角形の幅
dbl_myShapeH = myShape.Height   '四角形の高さ
dbl_CropLeft = dbl_myShapeL - dbl_mypicL         '左の調整値
dbl_CropTop = dbl_myShapeT - dbl_mypicT          '上の調整値
dbl_CropRight = (dbl_mypicW - dbl_myShapeW) - dbl_CropLeft
dbl_CropBottom = (dbl_mypicH - dbl_myShapeH) - dbl_CropTop
On Error Resume Next
With myPic.PictureFormat
    .CropLeft = dbl_CropLeft       '左の調整
    .CropTop = dbl_CropTop         '上の調整
    .CropRight = dbl_CropRight     '右の調整
    .CropBottom = dbl_CropBottom   '下の調整
End With
If Err.Number <> 0 Then _
    MsgBox (myPicture & "は写真ではありません。" _
    & vbCrLf & "トリミング出来る画像を選択して実行してください。")
On Error GoTo 0
Set myPic = Nothing
Set myShape = Nothing
End Sub

 （川野鮎太郎）

ありがとうございます！　川野鮎太郎　様、HANA　様

私が思っていた通りのものです。本当にありがとうございます！

（えりぐり）

 えりぐりさん、思ったことが出来て良かったです。
 以下、スレお借りします。

 鮎太郎さん
   ・・・そうなんですよね。ずっと2000を使っていると思っていたのに
   気づいたら2002でした。
   2000には「図の圧縮」無いのですね。
   鮎太郎さんを焚き付けて、完成した暁にはこそっと使わせてもらおう
   と言う野望に満ちあふれていたのですが・・・・・。
   残念です。

 とは言え、マクロの記録で「図の圧縮」を試したところ
 どうやら記録できないみたいなのです。
 (トリミングの値は記録に残るのですが)
 そう言えば以前みやほりんさんに教わった(身に付いてない証拠)
 「ダイアログボックスでのコントロール間のフォーカス移動などは記録されません。
   VBAはオペレーション（操作）志向のマクロではないからです。」[[20060803142042]]
 が今回も当てはまる・・・って事ですかね？？？
 それとも、これとはまた別の問題？
 (私の中では問題が別だと分類されているのですが。
  フォーカス移動ではなく、「図を圧縮した！！」だから
  記録されても良いような気がするんですよね。)
 やっぱりよく分かってない・・・。

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20060917194617]] 『画像のトリミング』（えりぐり） ページの最後に飛ぶ

[[20060917194617]]　『画像のトリミング』（えりぐり）　ページの最後に飛ぶ