Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- MyPath = ThisWorkbook.Path & "ScorecardJPEGs"
- Sheets("LocalMetrics").Select
- Set rgExp = Range("A1:AL77")
- rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
- With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
- Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
- .Name = "ChartTempEXPORT"
- .Activate
- End With
- ActiveChart.Paste
- ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export FileName:=MyPath & "Scorecard.jpg", _
- Filtername:="jpg"
- ActiveSheet.ChartObjects("ChartTempEXPORT").Delete
- Sub Create_jpg()
- Const fColumn As String = "A": Const lColumn As String = "AL"
- Const maxRange As Integer = 77
- Dim tempRowEnd As Integer: tempRowEnd = 0: Dim tempRowBegin As Integer: tempRowBegin = 0
- Dim loopCount As Integer: loopCount = 0
- Dim MyPath As String
- Dim rgExp As Range
- Dim lRowCount As Long:
- MyPath = ThisWorkbook.Path & "ScorecardJPEGs"
- Sheets("Sheet1").Select
- lRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
- Do
- tempRowBegin = tempRowEnd + 1 'chooses the first row in the selection
- tempRowEnd = tempRowEnd + maxRange 'chooses the end row in the selection
- Set rgExp = Range(fColumn & tempRowBegin & ":" & lColumn & tempRowEnd)
- rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
- With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
- Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
- .Name = "ChartTempEXPORT"
- .Activate
- End With
- ActiveChart.Paste
- ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export Filename:=MyPath & "Scorecard" & loopCount & ".jpg", _
- Filtername:="jpg"
- ActiveSheet.ChartObjects("ChartTempEXPORT").Delete
- loopCount = loopCount + 1 'increments count for naming convention
- Loop Until tempRowEnd > lRowCount
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement