|
これで、画像の右上のセルがわかります。
LT = ActiveSheet.Shapes("図 6").TopLeftCell.Address
BR = ActiveSheet.Shapes("図 6").BottomRightCell.Address
図形右上セル = Range(LT, BR).Rows(1).Cells(Range(LT, BR).Rows(1).Cells.Count).Address
MsgBox 図形右上セル
以下、過去ログを探せなかったので...。(内容は、当時のまま)
他は、API使うとか。
Sub 画像Jpeg保存()
Dim Cht As Chart
Dim Rgw As Single, Rgh As Single
Dim MRng As Range
With Sheets("Sheet2").Shapes("図 6")
'+7は、左、上の余白が消せないので、合わせる為の右、下の余白分
'セル範囲の場合は、余白が調整される?ドットとピクセルの違い?
Rgh = .Height + 7
Rgw = .Width + 7
.CopyPicture Format:=xlBitmap
End With
With ActiveSheet.ChartObjects.Add(0, 0, Rgw, Rgh).Chart
.Paste
.ChartArea.Border.LineStyle = 0
.Export CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\画像ファイルの名前.jpg"
.Parent.Delete
End With
End Sub
|
|