- Plot and others
- title editing & alignment
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) & " )" _
& "- " & Sheets(dataSheet).Cells(5, i) & "ft (L " & Sheets(dataSheet).Cells(6, i) & ")"
Selection.Characters.Text = chartTitle
Selection.Characters.Font.Size = 11
ActiveChart.chartTitle.Left = ActiveChart.ChartArea.Width
ActiveChart.chartTitle.Left = ActiveChart.chartTitle.Left / 2
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