CreateChartsFromSummary updated with table spacing, other refinements

-Keep each chart at 6.5" x 6.5"
-Space charts out so they don’t overlap
-Use white backgrounds for both chart and legend
-Arrange the legend in a single row at the bottom
-Remove titles entirely
This commit is contained in:
2025-08-13 21:21:49 +00:00
parent 3d99e6e830
commit 74c1422908

View File

@@ -206,41 +206,42 @@ Sub FormatSummaryTables()
End Sub End Sub
Sub CreateChartsFromSummary() Sub CreateChartsFromSummary()
Dim i As Integer Dim oDoc As Object, oSheet As Object, oCharts As Object
Dim iCat As Integer, iRow As Long Dim categories() As String, chartNames() As String
Dim oDoc As Object, oSheet As Object Dim iCat As Integer, iRow As Long, foundRow As Long
Dim categories() As String Dim titleRow As Long, headerRow As Long
Dim categoryColors() As Long
Dim chartNames() As String
Dim oCharts As Object
Dim chartWidth As Long
Dim posX As Long, posY As Long
Dim outRow As Long
Dim dataStartRow As Long, dataEndRow As Long Dim dataStartRow As Long, dataEndRow As Long
Dim lastCol As Long
Dim chartRangeAddress As Object Dim chartRangeAddress As Object
Dim chartObj As Object Dim chartObj As Object, oChart As Object, oDiagram As Object
Dim oChart As Object Dim chartPos As New com.sun.star.awt.Rectangle
Dim oDiagram As Object
' === Config ===
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
chartNames = Array("Temp Chart", "Wind Chart", "RH Chart", "Precip Chart", "Rainy Days Chart")
Const inch As Long = 2540 ' 1 inch in 1/100 mm
Dim chartWidth As Long, chartHeight As Long
chartWidth = 6.5 * inch
chartHeight = 6.5 * inch
Dim startX As Long, startY As Long, chartSpacing As Long
startX = 1000
startY = 1000
chartSpacing = 9.5 * inch ' vertical space between chart tops
oDoc = ThisComponent oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary") oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts oCharts = oSheet.Charts
' Configurable Dim outRow As Long
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
chartNames = Array("Temp Chart", "Wind Chart", "RH Chart", "Precip Chart", "Rainy Days Chart")
chartWidth = 6500 ' approx 6.5 inch * 1000 (adjust if needed)
posX = 1000
posY = 500
outRow = 0 outRow = 0
For iCat = LBound(categories) To UBound(categories) For iCat = LBound(categories) To UBound(categories)
Dim category As String Dim category As String
category = categories(iCat) category = categories(iCat)
' Find category table start row ' === Locate the table for this category ===
Dim foundRow As Long
foundRow = -1 foundRow = -1
For iRow = outRow To oSheet.Rows.Count - 1 For iRow = outRow To oSheet.Rows.Count - 1
If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then
@@ -248,21 +249,23 @@ Sub CreateChartsFromSummary()
Exit For Exit For
End If End If
Next iRow Next iRow
If foundRow = -1 Then If foundRow = -1 Then
MsgBox "Category " & category & " not found." MsgBox "Category " & category & " not found."
GoTo NextCategory GoTo NextCategory
End If End If
Dim titleRow As Long: titleRow = foundRow titleRow = foundRow
Dim headerRow As Long: headerRow = titleRow + 1 headerRow = titleRow + 1
dataStartRow = headerRow + 1 dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11 ' 12 months assumed dataEndRow = dataStartRow + 11 ' 12 months
Dim lastCol As Long: lastCol = 0 ' Find last column in header row
For i = 0 To oSheet.Columns.Count - 1 lastCol = 0
If Trim(oSheet.getCellByPosition(i, headerRow).String) = "" Then Exit For Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = i lastCol = lastCol + 1
Next i Loop
lastCol = lastCol - 1
If lastCol <= 0 Then If lastCol <= 0 Then
MsgBox "No data columns found for " & category MsgBox "No data columns found for " & category
@@ -271,36 +274,57 @@ Sub CreateChartsFromSummary()
chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress() chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress()
' Remove existing chart if present ' === Remove existing chart if present ===
If oCharts.hasByName(chartNames(iCat)) Then If oCharts.hasByName(chartNames(iCat)) Then
oCharts.removeByName(chartNames(iCat)) oCharts.removeByName(chartNames(iCat))
End If End If
Dim chartPos As New com.sun.star.awt.Rectangle ' === Position chart ===
chartPos.X = posX chartPos.X = startX
chartPos.Y = posY + iCat * 7000 chartPos.Y = startY + (iCat * chartSpacing)
chartPos.Width = chartWidth chartPos.Width = chartWidth
chartPos.Height = 20320 chartPos.Height = chartHeight
' === Create chart ===
oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True) oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True)
chartObj = oCharts.getByName(chartNames(iCat)) chartObj = oCharts.getByName(chartNames(iCat))
oChart = chartObj.EmbeddedObject oChart = chartObj.EmbeddedObject
' Set chart type to line diagram ' === Set diagram to Line Chart ===
oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram") oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram")
oDiagram.Vertical = False ' horizontal category axis
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS ' months on X-axis
oChart.setDiagram(oDiagram) oChart.setDiagram(oDiagram)
oChart.HasMainTitle = True ' === Remove main title ===
oChart.Title.String = category & " Comparison" oChart.HasMainTitle = False
' === Legend settings ===
oChart.HasLegend = True oChart.HasLegend = True
oChart.setPropertyValue("LegendPosition", com.sun.star.chart.ChartLegendPosition.BOTTOM) If oChart.Legend.supportsService("com.sun.star.chart.ChartLegend") Then
oChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM
oChart.Legend.FillColor = RGB(255, 255, 255)
End If
' === White background for chart ===
If oChart.supportsService("com.sun.star.chart.ChartDocument") Then
' Wall (plot area) background
oChart.setPropertyValue("WallColor", RGB(255, 255, 255))
' Floor (3D charts) background
On Error Resume Next
oChart.setPropertyValue("FloorColor", RGB(255, 255, 255))
On Error GoTo 0
' Chart area background (Diagram area)
If oDiagram.supportsService("com.sun.star.chart.Diagram") Then
oDiagram.setPropertyValue("FillColor", RGB(255, 255, 255))
End If
End If
outRow = dataEndRow + 2 outRow = dataEndRow + 2
NextCategory: NextCategory:
Next iCat Next iCat
MsgBox "Charts created." MsgBox "Charts created with requested formatting."
End Sub End Sub
Function Round(num, Optional decimals) Function Round(num, Optional decimals)