Excel macro - Chart plot with data sheet - Updated

[wwj]

Excel macro - Chart plot with data sheet - Updated [Excellent]

- Update data
- Page numbering
- Axis ranges

Code: Select all

Sub doPlot()
'
' doPlot Macro
'

'
    Dim initRowPlot  As Integer
    Dim initCol As Integer
    Dim rowNo  As Integer
    Dim colNo As Integer
    Dim dyRow As Integer
    Dim dataInitRow  As Integer
    Dim dataInitCol As Integer
    Dim dataRow  As Integer
    Dim dataCol As Integer
    Dim dataDcol As Integer
    Dim i As Integer
    Dim numPlot  As Integer
    Dim maxNumPlot As Integer
    Dim lastRow As Integer
    
    Dim dataSheet  As String
    Dim plotSheet As String
    Dim chartTitle As String
    Dim objCht As ChartObject
    Dim objShp As Shape
    Dim pgText As TextFrame2

    '*********************************************************
    
    dataSheet = "TestData"
    'dataSheet = "Targets_Transient_toPlot"
    plotSheet = "Plots"
    plotSample = "PlotTemplate"
    maxNumPlot = 1000
    '*********************************************************
    
    initRowPlot = 2
    initCol = 0
    dyRow = 37
    dxCol = 2
    
    ' Clear all contents
    Sheets(plotSheet).Select
    Sheets(plotSheet).Activate
    ActiveSheet.Cells.Clear                         ' Clear all cells.
    For Each objCht In ActiveSheet.ChartObjects     ' Remove all charts
        objCht.Delete
    Next
    ActiveSheet.DrawingObjects.Delete               ' Remove all drawing objects
    
    ' Set column width
    Columns("A").ColumnWidth = 1.57
    Columns("B:AB").ColumnWidth = 4.43
    
    ' Compute the number of data set.
    i = initCol
    numPlot = 0
    
    Do While i < maxNumPlot
        i = i + 2
        chartTitle = Sheets(dataSheet).Cells(1, i)
        
        If Not chartTitle = "" Then
            numPlot = numPlot + 1
        Else
            i = maxNumPlot
        End If
    Loop
    
    i = numPlot / 4
    If (numPlot > i * 4) Then
        maxNumPlot = i + 1
    Else
        maxNumPlot = i
    End If
    
    ' Copy the template plot
    colNo = initCol + 2
    
    For i = 1 To maxNumPlot
        rowNo = initRowPlot + (i - 1) * dyRow
        Sheets(plotSheet).Select
        ActiveSheet.Cells(rowNo, colNo).Select
        Sheets(plotSample).Select
        ActiveSheet.Shapes.Range(Array("Group 1")).Select
        Selection.Copy
        Sheets(plotSheet).Select
        ActiveSheet.Cells(rowNo, colNo).Select
        ActiveSheet.Paste
    Next i
    
    ActiveSheet.Range("B1").Select
    
    ' Update all plot data.
    i = 0
    For Each objCht In Worksheets(plotSheet).ChartObjects
        'Debug.Print objCht.Name
        ActiveSheet.ChartObjects(objCht.Name).Activate
        ActiveChart.chartTitle.Select
        
        i = i + 2
        chartTitle = Sheets(dataSheet).Cells(1, i)
        
        If Not chartTitle = "" Then
            lastRow = Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, i + 1).End(xlUp).Row
            
            chartTitle = Sheets(dataSheet).Cells(1, i) & " (" & Sheets(dataSheet).Cells(7, i) & " )"
            Selection.Characters.Text = chartTitle
            ActiveChart.SeriesCollection(1).XValues = _
                Sheets(dataSheet).Range(Sheets(dataSheet).Cells(9, i), Sheets(dataSheet).Cells(lastRow, i))
            ActiveChart.SeriesCollection(1).Values = _
                Sheets(dataSheet).Range(Sheets(dataSheet).Cells(9, i + 1), Sheets(dataSheet).Cells(lastRow, i + 1))
            ' Set a minimum for x-axis.
            If (WorksheetFunction.Min(ActiveChart.SeriesCollection(1).XValues)) < 0 Then
                ActiveChart.Axes(xlCategory).MinimumScale = 0
            End If
            
            ' Set Y-axis range
            minYaxis = WorksheetFunction.Min(ActiveChart.SeriesCollection(1).Values)
            maxYaxis = WorksheetFunction.Max(ActiveChart.SeriesCollection(1).Values)

            maxYaxis = Int(maxYaxis / 10) * 10 + 50
            minYaxis = Int(minYaxis / 10) * 10 - 50
            
            ActiveChart.Axes(xlValue).MinimumScale = minYaxis
            ActiveChart.Axes(xlValue).MaximumScale = maxYaxis
            
        Else
            ActiveSheet.ChartObjects(objCht.Name).Delete
        End If
    Next
    
    ActiveSheet.Range("B1").Select
    
    ' Update page numbers on the plots.
    i = 0
    For Each objShp In Worksheets(plotSheet).Shapes
        i = i + 1
        Set pgText = ActiveSheet.Shapes(objShp.Name).GroupItems("PageNo").TextFrame2
        pgText.TextRange.Characters.Text = "Page " & CStr(i) & " of " & CStr(maxNumPlot)
    Next
    
    ActiveSheet.Range("B1").Select
    
End Sub