From 74c14229089847f4287875072c8daba5ba461046 Mon Sep 17 00:00:00 2001 From: brightside Date: Wed, 13 Aug 2025 21:21:49 +0000 Subject: [PATCH] CreateChartsFromSummary updated with table spacing, other refinements MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit -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 --- WeatherMacros.bas | 136 +++++++++++++++++++++++++++------------------- 1 file changed, 80 insertions(+), 56 deletions(-) diff --git a/WeatherMacros.bas b/WeatherMacros.bas index 47b35f0..8b26836 100644 --- a/WeatherMacros.bas +++ b/WeatherMacros.bas @@ -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,59 +249,82 @@ 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 - - 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 - + dataEndRow = dataStartRow + 11 ' 12 months + + ' 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 GoTo NextCategory End If - + 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)