REM ***** BASIC ***** Option Explicit ' ==== BuildWeatherSummaries ==== Sub BuildWeatherSummaries() Dim oDoc As Object, oSheets As Object, oSheet 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 categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") ' UI rows: headers on row 23, data on rows 26–37 headerRow = 23 startRow = 26 endRow = 37 oDoc = ThisComponent oSheets = oDoc.Sheets ' Get REF sheet (for month abbreviations) 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 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 outRow = 0 Dim catIndex As Long For catIndex = LBound(categories) To UBound(categories) category = categories(catIndex) ' Title 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) 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 outCol = 1 ' Scan all sheets whose name contains "monthly" For sheetIndex = 0 To oSheets.Count - 1 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 col = col + 1 Loop End If Next sheetIndex ' Move output pointer below this table (+1 for header row +12 months) outRow = outRow + (endRow - startRow + 2) + 1 Next catIndex MsgBox "Weather summaries built successfully." 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 On Error Resume Next oSheet = oSheets.getByName(sheetName) SheetExists = (Err = 0) 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 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 oDoc = ThisComponent oSheet = oDoc.Sheets.getByName("Summary") categories = Array("Temp", "Wind", "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 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 dataStartRow As Long, dataEndRow As Long Dim chartRangeAddress As Object Dim chartObj As Object Dim oChart As Object Dim oDiagram As Object 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 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 foundRow = -1 For iRow = outRow To oSheet.Rows.Count - 1 If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then foundRow = iRow 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 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 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 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 chartPos.Width = chartWidth chartPos.Height = 20320 oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True) chartObj = oCharts.getByName(chartNames(iCat)) oChart = chartObj.EmbeddedObject ' Set chart type to line diagram oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram") oChart.setDiagram(oDiagram) oChart.HasMainTitle = True oChart.Title.String = category & " Comparison" oChart.HasLegend = True oChart.setPropertyValue("LegendPosition", com.sun.star.chart.ChartLegendPosition.BOTTOM) outRow = dataEndRow + 2 NextCategory: Next iCat MsgBox "Charts created." End Sub Function Round(num, Optional decimals) Dim factor If IsMissing(decimals) Then decimals = 0 End If factor = 10 ^ decimals Round = Int(num * factor + 0.5) / factor End Function