|
お世話になっております。
初心者ですが、勉強のために下記方法を試してみました。
画像保存機能を使えば写真のトリミングが出来るのでは?と思いやってみました。
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
|
|