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
Sub CreateChartsFromSummary()
Dim i As Integer
Dim iCat As Integer, iRow As Long
Dim oDoc As Object, oSheet As Object
Dim categories() As String
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 oDoc As Object, oSheet As Object, oCharts As Object
Dim categories() As String, chartNames() As String
Dim iCat As Integer, iRow As Long, foundRow As Long
Dim titleRow As Long, headerRow As Long
Dim dataStartRow As Long, dataEndRow As Long
Dim lastCol As Long
Dim chartRangeAddress As Object
Dim chartObj As Object
Dim oChart As Object
Dim oDiagram As Object
Dim chartObj As Object, oChart As Object, oDiagram As Object
Dim chartPos As New com.sun.star.awt.Rectangle
' === 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
oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts
' Configurable
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
Dim outRow As Long
outRow = 0
For iCat = LBound(categories) To UBound(categories)
Dim category As String
category = categories(iCat)
' Find category table start row
Dim foundRow As Long
' === Locate the table for this category ===
foundRow = -1
For iRow = outRow To oSheet.Rows.Count - 1
If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then
@@ -248,21 +249,23 @@ Sub CreateChartsFromSummary()
Exit For
End If
Next iRow
If foundRow = -1 Then
MsgBox "Category " & category & " not found."
GoTo NextCategory
End If
Dim titleRow As Long: titleRow = foundRow
Dim headerRow As Long: headerRow = titleRow + 1
titleRow = foundRow
headerRow = titleRow + 1
dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11 ' 12 months assumed
dataEndRow = dataStartRow + 11 ' 12 months
Dim lastCol As Long: lastCol = 0
For i = 0 To oSheet.Columns.Count - 1
If Trim(oSheet.getCellByPosition(i, headerRow).String) = "" Then Exit For
lastCol = i
Next i
' Find last column in header row
lastCol = 0
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
If lastCol <= 0 Then
MsgBox "No data columns found for " & category
@@ -271,36 +274,57 @@ Sub CreateChartsFromSummary()
chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress()
' Remove existing chart if present
' === Remove existing chart if present ===
If oCharts.hasByName(chartNames(iCat)) Then
oCharts.removeByName(chartNames(iCat))
End If
Dim chartPos As New com.sun.star.awt.Rectangle
chartPos.X = posX
chartPos.Y = posY + iCat * 7000
' === Position chart ===
chartPos.X = startX
chartPos.Y = startY + (iCat * chartSpacing)
chartPos.Width = chartWidth
chartPos.Height = 20320
chartPos.Height = chartHeight
' === Create chart ===
oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True)
chartObj = oCharts.getByName(chartNames(iCat))
oChart = chartObj.EmbeddedObject
' Set chart type to line diagram
' === Set diagram to Line Chart ===
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.HasMainTitle = True
oChart.Title.String = category & " Comparison"
' === Remove main title ===
oChart.HasMainTitle = False
' === Legend settings ===
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
NextCategory:
Next iCat
MsgBox "Charts created."
MsgBox "Charts created with requested formatting."
End Sub
Function Round(num, Optional decimals)