359 lines
13 KiB
QBasic
359 lines
13 KiB
QBasic
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
|
||
|
||
' Expanded categories
|
||
categories = Array( _
|
||
"Temp", _
|
||
"Wind Speed", _
|
||
"Wind Direction", _
|
||
"Rel Humidity", _
|
||
"Avg Total Liquid Precipitation", _
|
||
"Rainy Days", _
|
||
"Solar Radiation" _
|
||
)
|
||
|
||
' 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 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 sheets whose name contains "monthly"
|
||
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 ' safety limit
|
||
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
|
||
CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow
|
||
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 this 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
|
||
|
||
' ==== 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 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")
|
||
chartNames = Array("Temp Chart", "Wind Chart", "RH Chart", "Precip Chart", "Rainy Days 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 = 1000
|
||
startY = 1000
|
||
chartSpacing = 9.5 * inch ' vertical space between chart tops
|
||
|
||
oDoc = ThisComponent
|
||
oSheet = oDoc.Sheets.getByName("Summary")
|
||
oCharts = oSheet.Charts
|
||
|
||
Dim outRow As Long
|
||
outRow = 0
|
||
|
||
For iCat = LBound(categories) To UBound(categories)
|
||
Dim category As String
|
||
category = categories(iCat)
|
||
|
||
' === Locate the table for this category ===
|
||
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
|
||
|
||
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
|
||
|
||
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
|
||
|
||
' === 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 ' horizontal category axis
|
||
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS ' months on X-axis
|
||
oChart.setDiagram(oDiagram)
|
||
|
||
' === 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)
|
||
End If
|
||
|
||
' === White background for chart ===
|
||
If oChart.supportsService("com.sun.star.chart.ChartDocument") Then
|
||
' Wall (plot area) background
|
||
oChart.setPropertyValue("WallColor", RGB(255, 255, 255))
|
||
' Floor (3D charts) background
|
||
On Error Resume Next
|
||
oChart.setPropertyValue("FloorColor", RGB(255, 255, 255))
|
||
On Error GoTo 0
|
||
' Chart area background (Diagram area)
|
||
If oDiagram.supportsService("com.sun.star.chart.Diagram") Then
|
||
oDiagram.setPropertyValue("FillColor", RGB(255, 255, 255))
|
||
End If
|
||
End If
|
||
|
||
outRow = dataEndRow + 2
|
||
NextCategory:
|
||
Next iCat
|
||
|
||
MsgBox "Charts created with requested formatting."
|
||
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 |