2 Commits

View File

@@ -1,332 +1,268 @@
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
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
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
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")
' UI rows: headers on row 23, data on rows 2637
headerRow = 23
startRow = 26
endRow = 37
' 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)" _
)
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
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
Dim catIndex As Long
For catIndex = LBound(categories) To UBound(categories)
category = categories(catIndex)
' Title
oSummary.getCellByPosition(0, outRow).String = category & " Data Summary"
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
' Month header
oSummary.getCellByPosition(0, outRow).String = "Month"
' Source sheet
oSrc = oDoc.Sheets.getByName(srcSheets(iCat))
' Fill months (JanDec) 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
' Determine last column from source
lastCol = 0
Do While Trim(oSrc.getCellByPosition(lastCol, 0).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
outCol = 1
' Read headers from source
ReDim headers(lastCol)
For i = 0 To lastCol
headers(i) = oSrc.getCellByPosition(i, 0).String
Next i
' 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
' Clean headers
cleanedHeaders = CleanHeaders(headers, srcSheets(iCat))
headerLow = LCase(header)
' Write headers
For i = 0 To lastCol
oSummary.getCellByPosition(i, outRow).String = cleanedHeaders(i)
Next i
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
' 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
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."
' Next table
outRow = outRow + 12 + 2
Next iCat
End Sub
' ==== Helpers ====
Function CleanHeaders(origHeaders() As String, srcName As String) As Variant
Dim cleaned() As String, i As Long, h As String
ReDim cleaned(UBound(origHeaders))
' 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
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
' 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 ====
'========================
' 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 outRow As Long
Dim i As Long, j As Long
Dim iRow As Long
Dim rowPtr As Long, lastCol As Long
Dim j As Long, iRow As Long
Dim cell As Object
Dim rangeStart As Long, rangeEnd As Long
Dim categories() As String
Dim lastCol As Long
Dim headerRow As Long, dataStart As Long, dataEnd 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)
rowPtr = 0
Do While Trim(oSheet.getCellByPosition(0, rowPtr).String) <> ""
' Title row
cell = oSheet.getCellByPosition(0, outRow)
cell = oSheet.getCellByPosition(0, rowPtr)
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
' Header row
headerRow = rowPtr + 1
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
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1
Loop
lastCol = lastCol - 1
If lastCol < 0 Then Exit Do
' Header row formatting
For j = 0 To lastCol
cell = oSheet.getCellByPosition(j, outRow)
cell = oSheet.getCellByPosition(j, headerRow)
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.IsTextWrapped = True
cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00 orange
cell.CellBackColor = RGB(255, 173, 0) ' #FFAD00
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM ' <-- changed
cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM
Next j
' Data rows formatting
rangeStart = outRow + 1
rangeEnd = outRow + 12 ' assuming 12 months data rows
For iRow = rangeStart To rangeEnd
' 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
' No rounding here — NumberFormat is inherited from source
Next j
Next iRow
outRow = rangeEnd + 2
Next i
' 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() 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 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
' === 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")
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
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 = 1000
startX = 19 * 1000
startY = 1000
chartSpacing = 9.5 * inch ' vertical space between chart tops
chartSpacing = 9.5 * inch
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts
Dim outRow As Long
outRow = 0
' Remove existing charts
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 ===
foundRow = -1
For iRow = outRow To oSheet.Rows.Count - 1
If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then
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
MsgBox "Category " & category & " not found."
GoTo NextCategory
End If
If foundRow = -1 Then GoTo NextCategory
titleRow = foundRow
headerRow = titleRow + 1
dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11 ' 12 months
dataEndRow = dataStartRow + 11
' 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
If lastCol <= 0 Then GoTo NextCategory
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
oDiagram.Vertical = False
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
oChart.setDiagram(oDiagram)
' === Remove main title ===
oChart.HasMainTitle = False
On Error Resume Next
oDiagram.Wall.FillColor = RGB(255, 255, 255)
On Error GoTo 0
' === Legend settings ===
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
' === 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."
MsgBox "Charts created."
End Sub
' Simple Round helper
Function Round(num, Optional decimals)
Dim factor
If IsMissing(decimals) Then