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 ' Conversion constant from ly to kWh/m² Const LY_TO_KWH = 0.011622 ' 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 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) outRow = 0 Dim catIndex As Long For catIndex = LBound(categories) To UBound(categories) category = categories(catIndex) ' Title row oSummary.getCellByPosition(0, outRow).String = category & " Data Summary" outRow = outRow + 1 ' Month header oSummary.getCellByPosition(0, outRow).String = "Month" ' 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 outCol = 1 ' 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 headerLow = LCase(header) 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 pointer below table outRow = outRow + (endRow - startRow + 2) + 1 Next catIndex MsgBox "Weather summaries built successfully." End Sub ' ==== Helpers ==== 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 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 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 === 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 === 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 oChart.Legend.FillColor = RGB(255, 255, 255) 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." 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 decimals = 0 End If factor = 10 ^ decimals Round = Int(num * factor + 0.5) / factor End Function