Excel VBA質問箱 IV

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

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


29341 / 76732 ←次へ | 前へ→

【52673】画像の位置取得
質問    - 07/11/25(日) 20:42 -

引用なし
パスワード
   お世話になっております。
初心者ですが、勉強のために下記方法を試してみました。

画像保存機能を使えば写真のトリミングが出来るのでは?と思いやってみました。
1.写真を壁紙として表示
2.範囲を設定して画像保存
と、やってみたら、設定した範囲と異なる画像が保存されていました。
ネットを見てると画像処理にはよくTopとかLeftなどが出てくるので、これかな?と思い
本を見ながら適当に試してみましたが、うまくいきません。
下記コードは、普通に作成した表を画像保存する時に使っているコードを、★に変更して試したものです。

【現象】
どの場所を範囲設定しても、保存された画像はいつも
Range(”A1”)に近い部分が保存される(縦横サイズはOKです)。

【質問】
設定範囲した部分を、そのまま保存するためには、どうしたらいいのか教えて下さい。

Sub トリミングTEST()

Dim slcRng As Range
Dim crtObj As Chart
Dim strMsg As String, intMsg As String

ActiveWindow.DisplayGridlines = False
  strMsg = "保存ファイル名は?"
      intMsg = InputBox(strMsg)
      If intMsg = "" Then Exit Sub
    intMsg = "\" & intMsg

Set slcRng = Selection
  slcRng.CopyPicture appearance:=xlScreen, Format:=xlPicture

Set crtObj = ActiveSheet.ChartObjects.Add _
    (slcRng.Top, slcRng.Left, slcRng.Width, slcRng.Height).Chart '★試した箇所
  
'Set crtObj = ActiveSheet.ChartObjects.Add(0, 0, slcRng.Width, slcRng.Height).Chart '★元々のコード

  With crtObj
    .Paste
    .Export Filename:=ActiveWorkbook.Path & intMsg & ".gif", filtername:="GIF"
    .Parent.Delete
  End With

MsgBox "ブックが保存されているフォルダに保存されました"

End Sub
1 hits

【52673】画像の位置取得 07/11/25(日) 20:42 質問
【52682】Re:画像の位置取得 n 07/11/26(月) 11:59 発言
【52687】Re:画像の位置取得 07/11/26(月) 14:14 お礼
【52691】Re:画像の位置取得 n 07/11/26(月) 17:42 発言
【52692】Re:画像の位置取得 n 07/11/26(月) 20:16 発言
【52696】Re:画像の位置取得 07/11/26(月) 21:21 お礼
【52688】Re:画像の位置取得 Lindy 07/11/26(月) 14:30 発言
【52689】Re:画像の位置取得 Lindy 07/11/26(月) 15:25 発言
【52690】Re:画像の位置取得 07/11/26(月) 16:06 お礼

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