Advertisement
Guest User

Untitled

a guest
Mar 20th, 2019
45
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.91 KB | None | 0 0
  1. MyPath = ThisWorkbook.Path & "ScorecardJPEGs"
  2.  
  3. Sheets("LocalMetrics").Select
  4.  
  5. Set rgExp = Range("A1:AL77")
  6.  
  7. rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
  8.  
  9. With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
  10. Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
  11. .Name = "ChartTempEXPORT"
  12. .Activate
  13. End With
  14.  
  15. ActiveChart.Paste
  16. ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export FileName:=MyPath & "Scorecard.jpg", _
  17. Filtername:="jpg"
  18. ActiveSheet.ChartObjects("ChartTempEXPORT").Delete
  19.  
  20. Sub Create_jpg()
  21. Const fColumn As String = "A": Const lColumn As String = "AL"
  22. Const maxRange As Integer = 77
  23. Dim tempRowEnd As Integer: tempRowEnd = 0: Dim tempRowBegin As Integer: tempRowBegin = 0
  24. Dim loopCount As Integer: loopCount = 0
  25. Dim MyPath As String
  26. Dim rgExp As Range
  27. Dim lRowCount As Long:
  28. MyPath = ThisWorkbook.Path & "ScorecardJPEGs"
  29. Sheets("Sheet1").Select
  30. lRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
  31. Do
  32. tempRowBegin = tempRowEnd + 1 'chooses the first row in the selection
  33. tempRowEnd = tempRowEnd + maxRange 'chooses the end row in the selection
  34. Set rgExp = Range(fColumn & tempRowBegin & ":" & lColumn & tempRowEnd)
  35.  
  36. rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
  37. With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
  38. Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
  39. .Name = "ChartTempEXPORT"
  40. .Activate
  41. End With
  42.  
  43. ActiveChart.Paste
  44. ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export Filename:=MyPath & "Scorecard" & loopCount & ".jpg", _
  45. Filtername:="jpg"
  46. ActiveSheet.ChartObjects("ChartTempEXPORT").Delete
  47.  
  48. loopCount = loopCount + 1 'increments count for naming convention
  49. Loop Until tempRowEnd > lRowCount
  50.  
  51. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement