From d7909216a4f93fca6ea1c5550856cf241676e075 Mon Sep 17 00:00:00 2001 From: brightside Date: Fri, 15 Aug 2025 04:02:28 +0000 Subject: [PATCH] split wind speed and direction into two tables and added solar radiation --- WeatherMacros.bas | 78 ++++++++++++++++++++++++++++++----------------- 1 file changed, 50 insertions(+), 28 deletions(-) diff --git a/WeatherMacros.bas b/WeatherMacros.bas index 8b26836..b563d6d 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,7 +12,16 @@ Sub BuildWeatherSummaries() Dim headerCell As Object Dim outRow As Long - categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") + ' Expanded categories + categories = Array( _ + "Temp", _ + "Wind Speed", _ + "Wind Direction", _ + "Rel Humidity", _ + "Avg Total Liquid Precipitation", _ + "Rainy Days", _ + "Solar Radiation" _ + ) ' UI rows: headers on row 23, data on rows 26–37 headerRow = 23 @@ -43,14 +52,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 @@ -61,36 +70,58 @@ Sub BuildWeatherSummaries() ' Scan all sheets whose name contains "monthly" 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) 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 + CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow + 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 this table outRow = outRow + (endRow - startRow + 2) + 1 Next catIndex @@ -99,7 +130,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,35 +139,27 @@ 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