diff --git a/WeatherMacros.bas b/WeatherMacros.bas index cdf2402..1cb4284 100644 --- a/WeatherMacros.bas +++ b/WeatherMacros.bas @@ -1,367 +1,252 @@ REM ***** BASIC ***** - Option Explicit -' ==== BuildWeatherSummaries ==== Sub BuildWeatherSummaries() - 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 - Dim startRow As Long, endRow As Long, headerRow As Long - Dim headerCell As Object - Dim outRow As Long + Dim oDoc As Object, oSummary As Object + Dim categories(), srcSheets(), headerMap As Object + Dim iCat As Long, oSrc As Object + Dim outRow As Long, lastCol As Long + Dim headers() As String, cleanedHeaders() As String + Dim i As Long, r As Long - ' Conversion constant from ly to kWh/m² - Const LY_TO_KWH = 0.011622 + oDoc = ThisComponent + On Error Resume Next + oDoc.Sheets.getByName("Summary").dispose() + On Error GoTo 0 + oDoc.Sheets.insertNewByName("Summary", 0) + oSummary = oDoc.Sheets.getByName("Summary") - ' Categories to summarise + ' Define category mapping categories = Array( _ - "Temp", _ - "Wind Speed", _ - "Wind Direction", _ - "Rel Humidity", _ - "Avg Total Liquid Precipitation", _ - "Rainy Days", _ - "Solar Radiation" _ + "Monthly Avg Temp (degF)", _ + "Monthly Avg Wind Speed (mph)", _ + "Monthly Avg Rel Humidity (%)", _ + "Monthly Avg Total Liquid Precipitation (in)", _ + "Monthly Rainy Days (>0.1"" Liquid Precipitation)", _ + "Monthly Solar Radiation (kWh/m2/day)" _ ) - ' Positions: headers on row 23, data on rows 26–37 - headerRow = 23 - startRow = 26 - endRow = 37 - - oDoc = ThisComponent - oSheets = oDoc.Sheets - - ' 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") - - ' 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) + srcSheets = Array( _ + "PWS-WU Monthly", _ + "PWS-WU Monthly", _ + "PWS-WU Monthly", _ + "PWS-WU Monthly", _ + "PWS-WU Monthly", _ + "PWS-WU Monthly" _ + ) + ' Output row tracker outRow = 0 - Dim catIndex As Long - For catIndex = LBound(categories) To UBound(categories) - category = categories(catIndex) - + For iCat = LBound(categories) To UBound(categories) ' Title row - oSummary.getCellByPosition(0, outRow).String = category & " Data Summary" + oSummary.getCellByPosition(0, outRow).String = categories(iCat) & " Data Summary" + oSummary.getCellByPosition(0, outRow).CharWeight = com.sun.star.awt.FontWeight.BOLD outRow = outRow + 1 - ' Month header - oSummary.getCellByPosition(0, outRow).String = "Month" + ' Source sheet + oSrc = oDoc.Sheets.getByName(srcSheets(iCat)) - ' 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 - On Error GoTo 0 - Next row + ' Determine last column from source + lastCol = 0 + Do While Trim(oSrc.getCellByPosition(lastCol, 0).String) <> "" + lastCol = lastCol + 1 + Loop + lastCol = lastCol - 1 - outCol = 1 + ' Read headers from source + ReDim headers(lastCol) + For i = 0 To lastCol + headers(i) = oSrc.getCellByPosition(i, 0).String + Next i - ' 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 - headerCell = oSheet.getCellByPosition(col, headerRow - 1) - header = Trim(headerCell.String) - If header = "" Then Exit Do + ' Clean headers + cleanedHeaders = CleanHeaders(headers, srcSheets(iCat)) - headerLow = LCase(header) + ' Write headers + For i = 0 To lastCol + oSummary.getCellByPosition(i, outRow).String = cleanedHeaders(i) + Next i - 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 + ' Copy data (assumes 12 months starting at row 1 in source) + For r = 1 To 12 + For i = 0 To lastCol + oSummary.getCellByPosition(i, outRow + r).Value = oSrc.getCellByPosition(i, r).Value + Next i + Next r - 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 pointer below table - outRow = outRow + (endRow - startRow + 2) + 1 - Next catIndex - - MsgBox "Weather summaries built successfully." + ' Next table + outRow = outRow + 12 + 2 + Next iCat End Sub -' ==== Helpers ==== +Function CleanHeaders(origHeaders() As String, srcName As String) As Variant + Dim cleaned() As String, i As Long, h As String + ReDim cleaned(UBound(origHeaders)) -Function SheetExists(sheetName As String) As Boolean - Dim oSheets As Object, oSheet As Object - oSheets = ThisComponent.Sheets - On Error Resume Next - oSheet = oSheets.getByName(sheetName) - SheetExists = (Err = 0) - On Error GoTo 0 + For i = LBound(origHeaders) To UBound(origHeaders) + h = Trim(origHeaders(i)) + + ' Simple pattern-based cleanup + h = Replace(h, "PWS-WU Avg Max Temp (degF)", "PWS-WU Max") + h = Replace(h, "PWS-WU Avg Temp (degF)", "PWS-WU Avg") + h = Replace(h, "PWS-WU Avg Min Temp", "PWS-WU Min") + h = Replace(h, "RAWS Avg Max Temp (degF)", "RAWS Max") + h = Replace(h, "RAWS Avg Temp (degF)", "RAWS Avg") + h = Replace(h, "RAWS Avg Min Temp", "RAWS Min") + + ' Generic cleanups + h = Replace(h, " (degF)", "") + h = Replace(h, " (%)", "") + h = Replace(h, " (in)", "") + h = Replace(h, " (ly)", "") + h = Replace(h, " (kWh/m2/day)", "") + + cleaned(i) = h + Next i + + CleanHeaders = cleaned End Function -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 +'======================== +' FormatSummaryTables +'======================== +' Formats each summary table in order from the top of the Summary sheet, +' without hardcoding category names. Assumes each table is: +' Title row (R) +' Header row (R+1) +' Data rows (12) (R+2 .. R+13) +' Blank spacer (R+14) +Sub FormatSummaryTables() + Dim oDoc As Object, oSheet As Object + Dim rowPtr As Long, lastCol As Long + Dim j As Long, iRow As Long + Dim cell As Object + Dim headerRow As Long, dataStart As Long, dataEnd As Long - srcCell = srcSheet.getCellByPosition(srcCol, srcHeaderRow - 1) - headerText = srcSheet.Name & " " & srcCell.String - destSheet.getCellByPosition(destCol, destHeaderRow).String = headerText - - For r = 0 To (srcEndRow - srcStartRow) - srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r) - destCell = destSheet.getCellByPosition(destCol, destHeaderRow + 1 + r) - - 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 - destCell.String = srcCell.String - destCell.NumberFormat = srcCell.NumberFormat - End If - Next r -End Sub - -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 - - srcCell = srcSheet.getCellByPosition(srcCol, srcHeaderRow - 1) - headerText = srcSheet.Name & " " & srcCell.String & " (converted to kWh/m²/day)" - destSheet.getCellByPosition(destCol, destHeaderRow).String = headerText - - For r = 0 To (srcEndRow - srcStartRow) - srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r) - destCell = destSheet.getCellByPosition(destCol, destHeaderRow + 1 + r) - - 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 - 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, 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", "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 - chartWidth = 6.5 * inch - chartHeight = 6.5 * inch - - Dim startX As Long, startY As Long, chartSpacing As Long - startX = 19 * 1000 ' approx. column T - startY = 1000 - chartSpacing = 9.5 * inch - oDoc = ThisComponent oSheet = oDoc.Sheets.getByName("Summary") - oCharts = oSheet.Charts - - ' === 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 (case-insensitive search in column 0) === - foundRow = -1 - 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 in Summary sheet." - GoTo NextCategory - End If - - titleRow = foundRow - headerRow = titleRow + 1 - dataStartRow = headerRow + 1 - dataEndRow = dataStartRow + 11 ' 12 months - - ' === Find last column in header row === + + rowPtr = 0 + Do While Trim(oSheet.getCellByPosition(0, rowPtr).String) <> "" + ' Title row + cell = oSheet.getCellByPosition(0, rowPtr) + cell.CharWeight = com.sun.star.awt.FontWeight.BOLD + cell.CharHeight = 12 + cell.CellBackColor = RGB(255, 255, 255) + + ' Header row + headerRow = rowPtr + 1 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 - - ' === Chart range === + If lastCol < 0 Then Exit Do + + For j = 0 To lastCol + cell = oSheet.getCellByPosition(j, headerRow) + cell.CharWeight = com.sun.star.awt.FontWeight.BOLD + cell.IsTextWrapped = True + cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00 + cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER + cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM + Next j + + ' Data rows (next 12) + dataStart = headerRow + 1 + dataEnd = dataStart + 11 + For iRow = dataStart To dataEnd + For j = 0 To lastCol + cell = oSheet.getCellByPosition(j, iRow) + cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER + Next j + Next iRow + + ' Advance to next table (skip 12 data rows + header + blank spacer) + rowPtr = dataEnd + 2 + Loop + + MsgBox "Summary tables formatted." +End Sub + +Sub CreateChartsFromSummary() + Dim oDoc As Object, oSheet As Object, oCharts As Object + Dim categories(), chartNames() + Dim iCat As Long, foundRow As Long, iRow As Long + Dim titleRow As Long, headerRow As Long, dataStartRow As Long, dataEndRow As Long + Dim lastCol As Long + Dim chartRangeAddress As Object + Dim chartObj As Object, oChart As Object, oDiagram As Object + Dim chartPos As New com.sun.star.awt.Rectangle + + 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 + 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 = 19 * 1000 + startY = 1000 + chartSpacing = 9.5 * inch + + oDoc = ThisComponent + oSheet = oDoc.Sheets.getByName("Summary") + oCharts = oSheet.Charts + + ' Remove existing charts + Do While oCharts.getCount() > 0 + oCharts.removeByName(oCharts.getByIndex(0).Name) + Loop + + For iCat = LBound(categories) To UBound(categories) + foundRow = -1 + For iRow = 0 To oSheet.Rows.Count - 1 + If InStr(oSheet.getCellByPosition(0, iRow).String, categories(iCat)) > 0 Then + foundRow = iRow + Exit For + End If + Next iRow + + If foundRow = -1 Then GoTo NextCategory + + titleRow = foundRow + headerRow = titleRow + 1 + dataStartRow = headerRow + 1 + dataEndRow = dataStartRow + 11 + + lastCol = 0 + Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> "" + lastCol = lastCol + 1 + Loop + lastCol = lastCol - 1 + + If lastCol <= 0 Then GoTo NextCategory + chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress() - - ' === Position chart === + chartPos.X = startX chartPos.Y = startY + (iCat * chartSpacing) chartPos.Width = chartWidth chartPos.Height = chartHeight - - ' === Create chart === + oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True) chartObj = oCharts.getByName(chartNames(iCat)) oChart = chartObj.EmbeddedObject - - ' === Set diagram to Line Chart === + oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram") 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 - - ' === Legend settings === oChart.HasLegend = True If oChart.Legend.supportsService("com.sun.star.chart.ChartLegend") Then oChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM @@ -369,66 +254,15 @@ Sub CreateChartsFromSummary() oChart.Legend.Expansion = com.sun.star.chart.ChartLegendExpansion.WIDE oChart.Legend.CharHeight = 8 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 - + NextCategory: Next iCat - - MsgBox "Charts created with manual Y-axis scaling." + + MsgBox "Charts created." 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 +' Simple Round helper Function Round(num, Optional decimals) Dim factor If IsMissing(decimals) Then