Weather-Generator/WeatherMacros.bas

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