Advertisement
Combreal

SaveRangeASPict.vba

Mar 21st, 2023
1,523
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 0.69 KB | Source Code | 0 0
  1. Sub SaveRangeAsPicture()
  2.     'Save cell range as a JPG - www.thespreadsheetguru.com
  3.    Dim cht As ChartObject
  4.     Dim ActiveShape As Shape
  5.    
  6.     Range("D7:I32").Select
  7.     Selection.Copy
  8.     ActiveSheet.Pictures.Paste(link:=False).Select
  9.     Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
  10.     Set cht = ActiveSheet.ChartObjects.Add(Left:=ActiveCell.Left, Width:=ActiveShape.Width, Top:=ActiveCell.Top, Height:=ActiveShape.Height)
  11.     cht.ShapeRange.Fill.Visible = msoFalse
  12.     cht.ShapeRange.Line.Visible = msoFalse
  13.     ActiveShape.Copy
  14.     cht.Activate
  15.     ActiveChart.Paste
  16.     cht.Chart.Export "C:\temp\shape.jpg"
  17.     cht.Delete
  18.     ActiveShape.Delete
  19. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement