Files
Weather-Generator/WeatherMacros.bas

273 lines
8.7 KiB
QBasic

REM ***** BASIC *****
Option Explicit
Sub BuildWeatherSummaries()
Dim oDoc As Object, oSummary As Object
Dim categories(), srcSheets(), headerMap As Object
Dim iCat As Long, oSrc As Object
Dim outRow As Long, lastCol As Long
Dim headers() As String, cleanedHeaders() As String
Dim i As Long, r As Long
oDoc = ThisComponent
On Error Resume Next
oDoc.Sheets.getByName("Summary").dispose()
On Error GoTo 0
oDoc.Sheets.insertNewByName("Summary", 0)
oSummary = oDoc.Sheets.getByName("Summary")
' Define category mapping
categories = Array( _
"Monthly Avg Temp (degF)", _
"Monthly Avg Wind Speed (mph)", _
"Monthly Avg Rel Humidity (%)", _
"Monthly Avg Total Liquid Precipitation (in)", _
"Monthly Rainy Days (>0.1"" Liquid Precipitation)", _
"Monthly Solar Radiation (kWh/m2/day)" _
)
srcSheets = Array( _
"PWS-WU Monthly", _
"PWS-WU Monthly", _
"PWS-WU Monthly", _
"PWS-WU Monthly", _
"PWS-WU Monthly", _
"PWS-WU Monthly" _
)
' Output row tracker
outRow = 0
For iCat = LBound(categories) To UBound(categories)
' Title row
oSummary.getCellByPosition(0, outRow).String = categories(iCat) & " Data Summary"
oSummary.getCellByPosition(0, outRow).CharWeight = com.sun.star.awt.FontWeight.BOLD
outRow = outRow + 1
' Source sheet
oSrc = oDoc.Sheets.getByName(srcSheets(iCat))
' Determine last column from source
lastCol = 0
Do While Trim(oSrc.getCellByPosition(lastCol, 0).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
' Read headers from source
ReDim headers(lastCol)
For i = 0 To lastCol
headers(i) = oSrc.getCellByPosition(i, 0).String
Next i
' Clean headers
cleanedHeaders = CleanHeaders(headers, srcSheets(iCat))
' Write headers
For i = 0 To lastCol
oSummary.getCellByPosition(i, outRow).String = cleanedHeaders(i)
Next i
' Copy data (assumes 12 months starting at row 1 in source)
For r = 1 To 12
For i = 0 To lastCol
oSummary.getCellByPosition(i, outRow + r).Value = oSrc.getCellByPosition(i, r).Value
Next i
Next r
' Next table
outRow = outRow + 12 + 2
Next iCat
End Sub
Function CleanHeaders(origHeaders() As String, srcName As String) As Variant
Dim cleaned() As String, i As Long, h As String
ReDim cleaned(UBound(origHeaders))
For i = LBound(origHeaders) To UBound(origHeaders)
h = Trim(origHeaders(i))
' Simple pattern-based cleanup
h = Replace(h, "PWS-WU Avg Max Temp (degF)", "PWS-WU Max")
h = Replace(h, "PWS-WU Avg Temp (degF)", "PWS-WU Avg")
h = Replace(h, "PWS-WU Avg Min Temp", "PWS-WU Min")
h = Replace(h, "RAWS Avg Max Temp (degF)", "RAWS Max")
h = Replace(h, "RAWS Avg Temp (degF)", "RAWS Avg")
h = Replace(h, "RAWS Avg Min Temp", "RAWS Min")
' Generic cleanups
h = Replace(h, " (degF)", "")
h = Replace(h, " (%)", "")
h = Replace(h, " (in)", "")
h = Replace(h, " (ly)", "")
h = Replace(h, " (kWh/m2/day)", "")
cleaned(i) = h
Next i
CleanHeaders = cleaned
End Function
'========================
' FormatSummaryTables
'========================
' Formats each summary table in order from the top of the Summary sheet,
' without hardcoding category names. Assumes each table is:
' Title row (R)
' Header row (R+1)
' Data rows (12) (R+2 .. R+13)
' Blank spacer (R+14)
Sub FormatSummaryTables()
Dim oDoc As Object, oSheet As Object
Dim rowPtr As Long, lastCol As Long
Dim j As Long, iRow As Long
Dim cell As Object
Dim headerRow As Long, dataStart As Long, dataEnd As Long
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary")
rowPtr = 0
Do While Trim(oSheet.getCellByPosition(0, rowPtr).String) <> ""
' Title row
cell = oSheet.getCellByPosition(0, rowPtr)
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.CharHeight = 12
cell.CellBackColor = RGB(255, 255, 255)
' Header row
headerRow = rowPtr + 1
lastCol = 0
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
If lastCol < 0 Then Exit Do
For j = 0 To lastCol
cell = oSheet.getCellByPosition(j, headerRow)
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.IsTextWrapped = True
cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM
Next j
' Data rows (next 12)
dataStart = headerRow + 1
dataEnd = dataStart + 11
For iRow = dataStart To dataEnd
For j = 0 To lastCol
cell = oSheet.getCellByPosition(j, iRow)
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
Next j
Next iRow
' Advance to next table (skip 12 data rows + header + blank spacer)
rowPtr = dataEnd + 2
Loop
MsgBox "Summary tables formatted."
End Sub
Sub CreateChartsFromSummary()
Dim oDoc As Object, oSheet As Object, oCharts As Object
Dim categories(), chartNames()
Dim iCat As Long, foundRow As Long, iRow As Long
Dim titleRow As Long, headerRow As Long, 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
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
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
startY = 1000
chartSpacing = 9.5 * inch
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts
' Remove existing charts
Do While oCharts.getCount() > 0
oCharts.removeByName(oCharts.getByIndex(0).Name)
Loop
For iCat = LBound(categories) To UBound(categories)
foundRow = -1
For iRow = 0 To oSheet.Rows.Count - 1
If InStr(oSheet.getCellByPosition(0, iRow).String, categories(iCat)) > 0 Then
foundRow = iRow
Exit For
End If
Next iRow
If foundRow = -1 Then GoTo NextCategory
titleRow = foundRow
headerRow = titleRow + 1
dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11
lastCol = 0
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
If lastCol <= 0 Then GoTo NextCategory
chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress()
chartPos.X = startX
chartPos.Y = startY + (iCat * chartSpacing)
chartPos.Width = chartWidth
chartPos.Height = chartHeight
oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True)
chartObj = oCharts.getByName(chartNames(iCat))
oChart = chartObj.EmbeddedObject
oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram")
oDiagram.Vertical = False
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
oChart.setDiagram(oDiagram)
On Error Resume Next
oDiagram.Wall.FillColor = RGB(255, 255, 255)
On Error GoTo 0
oChart.HasMainTitle = False
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
NextCategory:
Next iCat
MsgBox "Charts created."
End Sub
' Simple Round helper
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