Weather-Generator/WeatherMacros

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