From e0a74bd9af26f41f48db8d15f39295c74f91a981 Mon Sep 17 00:00:00 2001 From: brightside Date: Fri, 15 Aug 2025 19:29:21 +0000 Subject: [PATCH] add solar and separate wind tables, convert ly to kwh/m2 in solar table automatically --- WeatherMacros.bas | 346 ++++++++++++++++++++++++++++++---------------- 1 file changed, 224 insertions(+), 122 deletions(-) diff --git a/WeatherMacros.bas b/WeatherMacros.bas index 8b26836..cdf2402 100644 --- a/WeatherMacros.bas +++ b/WeatherMacros.bas @@ -4,7 +4,7 @@ Option Explicit ' ==== BuildWeatherSummaries ==== Sub BuildWeatherSummaries() - Dim oDoc As Object, oSheets As Object, oSheet As Object, oSummary As Object, oRefSheet As Object + Dim oDoc As Object, oSheets As Object, oSummary As Object, oRefSheet As Object Dim sheetIndex As Long, col As Long, outCol As Long, row As Long Dim category As String, header As String, headerLow As String Dim categories() As String @@ -12,9 +12,21 @@ Sub BuildWeatherSummaries() Dim headerCell As Object Dim outRow As Long - categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") + ' Conversion constant from ly to kWh/m² + Const LY_TO_KWH = 0.011622 - ' UI rows: headers on row 23, data on rows 26–37 + ' Categories to summarise + categories = Array( _ + "Temp", _ + "Wind Speed", _ + "Wind Direction", _ + "Rel Humidity", _ + "Avg Total Liquid Precipitation", _ + "Rainy Days", _ + "Solar Radiation" _ + ) + + ' Positions: headers on row 23, data on rows 26–37 headerRow = 23 startRow = 26 endRow = 37 @@ -22,20 +34,20 @@ Sub BuildWeatherSummaries() oDoc = ThisComponent oSheets = oDoc.Sheets - ' Get REF sheet (for month abbreviations) + ' REF sheet for month names If Not SheetExists("REF") Then MsgBox "Reference sheet 'REF' not found! Cannot pull month abbreviations." Exit Sub End If oRefSheet = oSheets.getByName("REF") - ' Create or clear the Summary sheet + ' Summary sheet create or clear If Not SheetExists("Summary") Then oSummary = oSheets.createByName("Summary", oSheets.Count) oSheets.insertByName("Summary", oSummary) End If oSummary = oSheets.getByName("Summary") - oSummary.clearContents(1023) ' clear all + oSummary.clearContents(1023) outRow = 0 @@ -43,14 +55,14 @@ Sub BuildWeatherSummaries() For catIndex = LBound(categories) To UBound(categories) category = categories(catIndex) - ' Title + ' Title row oSummary.getCellByPosition(0, outRow).String = category & " Data Summary" outRow = outRow + 1 ' Month header oSummary.getCellByPosition(0, outRow).String = "Month" - ' Fill months (Jan–Dec) from REF sheet, column A, rows 0..11 (zero-based) + ' Fill months from REF sheet For row = 0 To 11 On Error Resume Next oSummary.getCellByPosition(0, outRow + row + 1).String = oRefSheet.getCellByPosition(0, row).String @@ -59,38 +71,66 @@ Sub BuildWeatherSummaries() outCol = 1 - ' Scan all sheets whose name contains "monthly" + ' Scan all "monthly" sheets For sheetIndex = 0 To oSheets.Count - 1 + Dim oSheet As Object oSheet = oSheets.getByIndex(sheetIndex) If InStr(LCase(oSheet.Name), "monthly") > 0 Then col = 0 - Do While col < 100 ' safety limit - ' Read header text from the real header row (UI row 23 -> zero-based 22) + Do While col < 100 headerCell = oSheet.getCellByPosition(col, headerRow - 1) header = Trim(headerCell.String) If header = "" Then Exit Do headerLow = LCase(header) - If category = "Temp" Then - If InStr(headerLow, "avg") > 0 And InStr(headerLow, "temp") > 0 Then - ' copy using the TRUE header row, and data rows 26..37 - CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow - outCol = outCol + 1 - End If - Else - If InStr(headerLow, LCase(category)) > 0 Then - CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow - outCol = outCol + 1 - End If - End If + Select Case category + Case "Temp" + If InStr(headerLow, "avg") > 0 And InStr(headerLow, "temp") > 0 Then + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + outCol = outCol + 1 + End If + + Case "Wind Speed" + If InStr(headerLow, "wind") > 0 _ + And InStr(headerLow, "dir") = 0 _ + And InStr(headerLow, "direction") = 0 Then + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + outCol = outCol + 1 + End If + + Case "Wind Direction" + If InStr(headerLow, "wind") > 0 _ + And (InStr(headerLow, "dir") > 0 Or InStr(headerLow, "direction") > 0) Then + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + outCol = outCol + 1 + End If + + Case "Solar Radiation" + If InStr(headerLow, "solar radiation") > 0 Then + If InStr(headerLow, "kwh/m2") > 0 Then + ' Already in kWh/m²/day + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + ElseIf InStr(headerLow, "ly") > 0 Then + ' Convert from ly + CopyColumnDataWithConversion oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow, LY_TO_KWH + End If + outCol = outCol + 1 + End If + + Case Else + If InStr(headerLow, LCase(category)) > 0 Then + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + outCol = outCol + 1 + End If + End Select col = col + 1 Loop End If Next sheetIndex - ' Move output pointer below this table (+1 for header row +12 months) + ' Move pointer below table outRow = outRow + (endRow - startRow + 2) + 1 Next catIndex @@ -99,7 +139,6 @@ End Sub ' ==== Helpers ==== -' Check if a sheet exists Function SheetExists(sheetName As String) As Boolean Dim oSheets As Object, oSheet As Object oSheets = ThisComponent.Sheets @@ -109,102 +148,122 @@ Function SheetExists(sheetName As String) As Boolean On Error GoTo 0 End Function -' Copy one source column (using the TRUE header row) into the summary table, -' preserving number formats for data cells. -' Now prefixes header with the source sheet name. Sub CopyColumnData(srcSheet As Object, srcCol As Long, srcHeaderRow As Long, _ destSheet As Object, destCol As Long, destHeaderRow As Long, _ srcStartRow As Long, srcEndRow As Long) - Dim r As Long Dim srcCell As Object, destCell As Object Dim headerText As String - ' Copy header from the real header row and prefix with sheet name srcCell = srcSheet.getCellByPosition(srcCol, srcHeaderRow - 1) headerText = srcSheet.Name & " " & srcCell.String destSheet.getCellByPosition(destCol, destHeaderRow).String = headerText - ' Copy data rows (26..37) and preserve number format For r = 0 To (srcEndRow - srcStartRow) - srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r) ' zero-based conversion + srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r) destCell = destSheet.getCellByPosition(destCol, destHeaderRow + 1 + r) - ' Preserve empties and text; copy numbers with format If srcCell.Type = com.sun.star.table.CellContentType.EMPTY Then destCell.String = "" ElseIf srcCell.Type = com.sun.star.table.CellContentType.VALUE Then destCell.Value = srcCell.Value destCell.NumberFormat = srcCell.NumberFormat Else - ' text/formula-as-text destCell.String = srcCell.String destCell.NumberFormat = srcCell.NumberFormat End If Next r End Sub -' ==== FormatSummaryTables ==== -Sub FormatSummaryTables() - Dim oDoc As Object, oSheet As Object - Dim outRow As Long - Dim i As Long, j As Long - Dim iRow As Long - Dim cell As Object - Dim rangeStart As Long, rangeEnd As Long - Dim categories() As String - Dim lastCol As Long +Sub CopyColumnDataWithConversion(srcSheet As Object, srcCol As Long, srcHeaderRow As Long, _ + destSheet As Object, destCol As Long, destHeaderRow As Long, _ + srcStartRow As Long, srcEndRow As Long, convFactor As Double) + Dim r As Long + Dim srcCell As Object, destCell As Object + Dim headerText As String - oDoc = ThisComponent - oSheet = oDoc.Sheets.getByName("Summary") + srcCell = srcSheet.getCellByPosition(srcCol, srcHeaderRow - 1) + headerText = srcSheet.Name & " " & srcCell.String & " (converted to kWh/m²/day)" + destSheet.getCellByPosition(destCol, destHeaderRow).String = headerText - categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") - outRow = 0 + For r = 0 To (srcEndRow - srcStartRow) + srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r) + destCell = destSheet.getCellByPosition(destCol, destHeaderRow + 1 + r) - For i = LBound(categories) To UBound(categories) - ' Title row - cell = oSheet.getCellByPosition(0, outRow) - cell.CharWeight = com.sun.star.awt.FontWeight.BOLD - cell.CharHeight = 12 - cell.CellBackColor = RGB(255, 255, 255) - outRow = outRow + 1 - - ' Find last used column in header row - lastCol = 0 - For j = 0 To oSheet.Columns.Count - 1 - cell = oSheet.getCellByPosition(j, outRow) - If Trim(cell.String) = "" Then Exit For - lastCol = j - Next j - - ' Header row formatting - For j = 0 To lastCol - cell = oSheet.getCellByPosition(j, outRow) - cell.CharWeight = com.sun.star.awt.FontWeight.BOLD - cell.IsTextWrapped = True - cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00 orange - cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER - cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM ' <-- changed - Next j - - ' Data rows formatting - rangeStart = outRow + 1 - rangeEnd = outRow + 12 ' assuming 12 months data rows - - For iRow = rangeStart To rangeEnd - For j = 0 To lastCol - cell = oSheet.getCellByPosition(j, iRow) - cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER - ' No rounding here — NumberFormat is inherited from source - Next j - Next iRow - - outRow = rangeEnd + 2 - Next i - - MsgBox "Summary tables formatted." + If srcCell.Type = com.sun.star.table.CellContentType.EMPTY Then + destCell.String = "" + ElseIf srcCell.Type = com.sun.star.table.CellContentType.VALUE Then + destCell.Value = srcCell.Value * convFactor + Else + On Error Resume Next + destCell.Value = CDbl(srcCell.String) * convFactor + On Error GoTo 0 + End If + Next r End Sub +' ==== FormatSummaryTables ==== + Sub FormatSummaryTables() + Dim oDoc As Object, oSheet As Object + Dim outRow As Long + Dim i As Long, j As Long + Dim iRow As Long + Dim cell As Object + Dim rangeStart As Long, rangeEnd As Long + Dim categories() As String + Dim lastCol As Long + + oDoc = ThisComponent + oSheet = oDoc.Sheets.getByName("Summary") + + categories = Array("Temp", "Solar Radiation", "Wind", "Wind Direction", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") + outRow = 0 + + For i = LBound(categories) To UBound(categories) + ' Title row + cell = oSheet.getCellByPosition(0, outRow) + cell.CharWeight = com.sun.star.awt.FontWeight.BOLD + cell.CharHeight = 12 + cell.CellBackColor = RGB(255, 255, 255) + outRow = outRow + 1 + + ' Find last used column in header row + lastCol = 0 + For j = 0 To oSheet.Columns.Count - 1 + cell = oSheet.getCellByPosition(j, outRow) + If Trim(cell.String) = "" Then Exit For + lastCol = j + Next j + + ' Header row formatting + For j = 0 To lastCol + cell = oSheet.getCellByPosition(j, outRow) + cell.CharWeight = com.sun.star.awt.FontWeight.BOLD + cell.IsTextWrapped = True + cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00 orange + cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER + cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM ' <-- changed + Next j + + ' Data rows formatting + rangeStart = outRow + 1 + rangeEnd = outRow + 12 ' assuming 12 months data rows + + For iRow = rangeStart To rangeEnd + For j = 0 To lastCol + cell = oSheet.getCellByPosition(j, iRow) + cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER + ' No rounding here — NumberFormat is inherited from source + Next j + Next iRow + + outRow = rangeEnd + 2 + Next i + + MsgBox "Summary tables formatted." + End Sub + + Sub CreateChartsFromSummary() Dim oDoc As Object, oSheet As Object, oCharts As Object Dim categories() As String, chartNames() As String @@ -217,8 +276,8 @@ Sub CreateChartsFromSummary() 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") + categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days", "Solar Radiation") + chartNames = Array("Temp Chart", "Wind Chart", "RH Chart", "Precip Chart", "Rainy Days Chart", "Solar Chart") Const inch As Long = 2540 ' 1 inch in 1/100 mm Dim chartWidth As Long, chartHeight As Long @@ -226,32 +285,34 @@ Sub CreateChartsFromSummary() chartHeight = 6.5 * inch Dim startX As Long, startY As Long, chartSpacing As Long - startX = 1000 + startX = 19 * 1000 ' approx. column T startY = 1000 - chartSpacing = 9.5 * inch ' vertical space between chart tops + chartSpacing = 9.5 * inch oDoc = ThisComponent oSheet = oDoc.Sheets.getByName("Summary") oCharts = oSheet.Charts - Dim outRow As Long - outRow = 0 + ' === Remove ALL existing charts from the sheet === + Do While oCharts.getCount() > 0 + oCharts.removeByName(oCharts.getByIndex(0).Name) + Loop For iCat = LBound(categories) To UBound(categories) Dim category As String category = categories(iCat) - ' === Locate the table for this category === + ' === Locate the table for this category (case-insensitive search in column 0) === foundRow = -1 - For iRow = outRow To oSheet.Rows.Count - 1 - If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then + For iRow = 0 To oSheet.Rows.Count - 1 + If InStr(LCase(oSheet.getCellByPosition(0, iRow).String), LCase(category)) > 0 Then foundRow = iRow Exit For End If Next iRow If foundRow = -1 Then - MsgBox "Category " & category & " not found." + MsgBox "Category '" & category & "' not found in Summary sheet." GoTo NextCategory End If @@ -260,7 +321,7 @@ Sub CreateChartsFromSummary() dataStartRow = headerRow + 1 dataEndRow = dataStartRow + 11 ' 12 months - ' Find last column in header row + ' === Find last column in header row === lastCol = 0 Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> "" lastCol = lastCol + 1 @@ -272,13 +333,9 @@ Sub CreateChartsFromSummary() GoTo NextCategory End If + ' === Chart range === chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress() - ' === Remove existing chart if present === - If oCharts.hasByName(chartNames(iCat)) Then - oCharts.removeByName(chartNames(iCat)) - End If - ' === Position chart === chartPos.X = startX chartPos.Y = startY + (iCat * chartSpacing) @@ -292,10 +349,15 @@ Sub CreateChartsFromSummary() ' === 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 + oDiagram.Vertical = False + oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS oChart.setDiagram(oDiagram) + ' === White chart wall === + On Error Resume Next + oDiagram.Wall.FillColor = RGB(255, 255, 255) + On Error GoTo 0 + ' === Remove main title === oChart.HasMainTitle = False @@ -304,29 +366,69 @@ Sub CreateChartsFromSummary() 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) + oChart.Legend.Expansion = com.sun.star.chart.ChartLegendExpansion.WIDE + oChart.Legend.CharHeight = 8 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 + ' === Calculate Y axis min/max === + Dim minVal As Double, maxVal As Double + minVal = 1E+20 + maxVal = -1E+20 + Dim r As Long, c As Long, val As Double + For r = dataStartRow To dataEndRow + For c = 1 To lastCol ' skip month names + If IsNumeric(oSheet.getCellByPosition(c, r).Value) Then + val = oSheet.getCellByPosition(c, r).Value + If val < minVal Then minVal = val + If val > maxVal Then maxVal = val + End If + Next c + Next r + + Dim stepSize As Double + stepSize = ChooseStepSize(maxVal - minVal) + minVal = Int(minVal / stepSize) * stepSize + maxVal = (Int((maxVal + stepSize - 0.000001) / stepSize)) * stepSize + + ' === Apply manual Y-axis scaling === + Dim yAxis As Object + yAxis = oDiagram.getYAxis() + If Not IsNull(yAxis) Then + yAxis.AutoMin = False + yAxis.AutoMax = False + yAxis.Min = minVal + yAxis.Max = maxVal + yAxis.StepMain = stepSize End If - outRow = dataEndRow + 2 NextCategory: Next iCat - MsgBox "Charts created with requested formatting." + MsgBox "Charts created with manual Y-axis scaling." End Sub +Function ChooseStepSize(rangeVal As Double) As Double + If rangeVal <= 1 Then + ChooseStepSize = 0.1 + ElseIf rangeVal <= 5 Then + ChooseStepSize = 0.5 + ElseIf rangeVal <= 10 Then + ChooseStepSize = 1 + ElseIf rangeVal <= 20 Then + ChooseStepSize = 2 + ElseIf rangeVal <= 50 Then + ChooseStepSize = 5 + ElseIf rangeVal <= 100 Then + ChooseStepSize = 10 + ElseIf rangeVal <= 200 Then + ChooseStepSize = 20 + ElseIf rangeVal <= 500 Then + ChooseStepSize = 50 + Else + ChooseStepSize = 100 + End If +End Function + Function Round(num, Optional decimals) Dim factor If IsMissing(decimals) Then