Code: Select all
Sub PlotAll()
'
' PlotAll 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 = "FormedData"
plotSheet = "AnalysisPlot"
plotSample = "PlotTemplate"
maxNumPlot = 1000
'*********************************************************
initRowPlot = 2
initCol = 1
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
chartTitle = Sheets(dataSheet).Cells(1, i)
If Not chartTitle = "" Then
numPlot = numPlot + 1
Else
i = maxNumPlot
End If
i = i + 4 ' 4 columns for each well
Loop
i = numPlot / 4 ' 4 graphs per page.
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 observation plot data.
i = 1
For Each objCht In Worksheets(plotSheet).ChartObjects
'Debug.Print objCht.Name
ActiveSheet.ChartObjects(objCht.Name).Activate
ActiveChart.chartTitle.Select
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(3, i), Sheets(dataSheet).Cells(lastRow, i))
ActiveChart.SeriesCollection(1).Values = _
Sheets(dataSheet).Range(Sheets(dataSheet).Cells(3, 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
i = i + 4
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