|
こんばんわ。
昼間のカキコはくっつける場所間違えてしもた(^^;;
・・・で、家帰ってコードみてみました。
xlPrinter は修正するとして、他の箇所でっけど、
Selection の扱いを間違ってるから変になったんやないかな?
わてのコードではちょっとややこしいけど前半に出てくる Selection と
後半の Selection とは対象(参照先)が違うんです。
前半(CopyPicture まで)では選択したセル範囲の意味やねんけど、
.Height = Selection.Height + (.Chart.ChartArea.Top) * 2
の箇所では、貼り付けた図が対象に変化してます。
で、CopyPicture の部分で Selection をコピーするって命令になってるわけやけど、
その前に Sheets(JPG_Sheet).Range(JPG_Sele) は選択されてるんでっか?
肝心の部分が省略されててわからんのやけど、もし選択してないんやったら
全然別の今選択してる部分をコピーしてる可能性もあります。
ねこぽんはんの使い方やったらここは Selection やのうて、セル範囲を明示したほうが
ええと思います。
後半部分で Selection の参照先が変化してるってのは、
.Height = Selection.Height + (.Chart.ChartArea.Top) * 2
の前の .Chart.Paste を実行すると選択されてるものがセル範囲から図に変わるからです。
つまり、この部分については Selection のままにしておけばええってことです。
コードの順番も元コードのように .Chart.Paste の後にサイズ調整をやらんとあきまへん。
それと、「工夫が必要」って書いたのは貼り付けてから図のサイズに合わせるだけでは
右と下がちょん切れてまうので、ちょっとだけサイズを大きくする必要があるんです。
ChartObjects の中の ChartArea の Left や Top が 0 ではなく、変更できないからです。
せやから + (.Chart.ChartArea.Top) * 2 でサイズ調節してるわけです。
・・・ってことで、↓これでどうでっしゃろ?
Sub test2()
Dim JPG_Sheet As String
Dim JPG_Sele As String
JPG_Sheet = "Sheet1"
JPG_Sele = "A1:C5"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Worksheets(JPG_Sheet).Range(JPG_Sele).CopyPicture xlPrinter
With Worksheets.Add
Charts.Add.Location Where:=xlLocationAsObject, Name:=.Name
With .ChartObjects(1)
.Border.LineStyle = xlLineStyleNone
.Chart.Paste
.Height = Selection.Height + (.Chart.ChartArea.Top) * 2
.Width = Selection.Width + (.Chart.ChartArea.Left) * 2
.Chart.Export Filename:="C:\Test.jpg", FilterName:="JPG"
End With
.Delete
End With
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
シート名やセル範囲は適当に書いてるんで変更してください。
わての環境ではうまいこといきました。
試してみてな。
ほな。
|
|