またもや画像関連で。
Q&A板でもたまにあるお題。
ワークシート範囲やシェイプを画像ファイルとして保存したい...など。
私は普通にキャプチャソフトを使ってしまうが、意外とニーズがあるよう。
本格的なものはWin32APIを使うのだろうし、
大量の画像であればPublishObjectsを使うのかな、という気がするけど、
まぁ、お手軽感という意味で。
ChartObjects.Addを繰り返すとファイルサイズが大きくなっていく...という話もあったので
作業Workbooks.Addで書いてみたけど、事の真相は未確認。
ChartObjectsのAdd/Deleteでいいような気もします。
コード中の -3.4 は余白の調整ですが、なんかちょっとカッコ悪いかも。
それに環境によって違うかもしれないし :-(
(出力sample)
Q&A板でもたまにあるお題。
ワークシート範囲やシェイプを画像ファイルとして保存したい...など。
私は普通にキャプチャソフトを使ってしまうが、意外とニーズがあるよう。
本格的なものはWin32APIを使うのだろうし、
大量の画像であればPublishObjectsを使うのかな、という気がするけど、
まぁ、お手軽感という意味で。
Sub try() Const f As String = "D:¥test¥test." Const e As String = "png" Dim r As Object On Error GoTo errHndr Set r = Selection r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap With Workbooks.Add(xlWBATWorksheet) With .Sheets(1).ChartObjects.Add(r.Left, r.Top, r.Width, r.Height).Chart .Paste .ChartArea.Border.LineStyle = 0 .Shapes(1).Left = -3.4 .Shapes(1).Top = -3.4 .Export Filename:=f & e, Filtername:=e End With .Close savechanges:=False End With errHndr: Set r = Nothing If Err.Number <> 0 Then MsgBox Err.Number & ":" & Err.Description End Sub
ChartObjects.Addを繰り返すとファイルサイズが大きくなっていく...という話もあったので
作業Workbooks.Addで書いてみたけど、事の真相は未確認。
ChartObjectsのAdd/Deleteでいいような気もします。
コード中の -3.4 は余白の調整ですが、なんかちょっとカッコ悪いかも。
それに環境によって違うかもしれないし :-(
(出力sample)
