1 Commits

Author SHA1 Message Date
803fa1f7ba chatgpt proposed for header simplification 2025-08-15 20:00:01 +00:00

View File

@@ -1,291 +1,195 @@
REM ***** BASIC ***** REM ***** BASIC *****
Option Explicit Option Explicit
' ==== BuildWeatherSummaries ====
Sub BuildWeatherSummaries() Sub BuildWeatherSummaries()
Dim oDoc As Object, oSheets As Object, oSummary As Object, oRefSheet As Object Dim oDoc As Object, oSummary As Object
Dim sheetIndex As Long, col As Long, outCol As Long, row As Long Dim categories(), srcSheets(), headerMap As Object
Dim category As String, header As String, headerLow As String Dim iCat As Long, oSrc As Object
Dim categories() As String Dim outRow As Long, lastCol As Long
Dim startRow As Long, endRow As Long, headerRow As Long Dim headers() As String, cleanedHeaders() As String
Dim headerCell As Object Dim i As Long, r As Long
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 2637
headerRow = 23
startRow = 26
endRow = 37
oDoc = ThisComponent oDoc = ThisComponent
oSheets = oDoc.Sheets On Error Resume Next
oDoc.Sheets.getByName("Summary").dispose()
On Error GoTo 0
oDoc.Sheets.insertNewByName("Summary", 0)
oSummary = oDoc.Sheets.getByName("Summary")
' REF sheet for month names ' Define category mapping
If Not SheetExists("REF") Then categories = Array( _
MsgBox "Reference sheet 'REF' not found! Cannot pull month abbreviations." "Monthly Avg Temp (degF)", _
Exit Sub "Monthly Avg Wind Speed (mph)", _
End If "Monthly Avg Rel Humidity (%)", _
oRefSheet = oSheets.getByName("REF") "Monthly Avg Total Liquid Precipitation (in)", _
"Monthly Rainy Days (>0.1"" Liquid Precipitation)", _
"Monthly Solar Radiation (kWh/m2/day)" _
)
' Summary sheet create or clear srcSheets = Array( _
If Not SheetExists("Summary") Then "PWS-WU Monthly", _
oSummary = oSheets.createByName("Summary", oSheets.Count) "PWS-WU Monthly", _
oSheets.insertByName("Summary", oSummary) "PWS-WU Monthly", _
End If "PWS-WU Monthly", _
oSummary = oSheets.getByName("Summary") "PWS-WU Monthly", _
oSummary.clearContents(1023) "PWS-WU Monthly" _
)
' Output row tracker
outRow = 0 outRow = 0
Dim catIndex As Long For iCat = LBound(categories) To UBound(categories)
For catIndex = LBound(categories) To UBound(categories)
category = categories(catIndex)
' Title row ' Title row
oSummary.getCellByPosition(0, outRow).String = category & " Data Summary" oSummary.getCellByPosition(0, outRow).String = categories(iCat) & " Data Summary"
oSummary.getCellByPosition(0, outRow).CharWeight = com.sun.star.awt.FontWeight.BOLD
outRow = outRow + 1 outRow = outRow + 1
' Month header ' Source sheet
oSummary.getCellByPosition(0, outRow).String = "Month" oSrc = oDoc.Sheets.getByName(srcSheets(iCat))
' Fill months from REF sheet ' Determine last column from source
For row = 0 To 11 lastCol = 0
On Error Resume Next Do While Trim(oSrc.getCellByPosition(lastCol, 0).String) <> ""
oSummary.getCellByPosition(0, outRow + row + 1).String = oRefSheet.getCellByPosition(0, row).String lastCol = lastCol + 1
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 Loop
End If lastCol = lastCol - 1
Next sheetIndex
' Move pointer below table ' Read headers from source
outRow = outRow + (endRow - startRow + 2) + 1 ReDim headers(lastCol)
Next catIndex For i = 0 To lastCol
headers(i) = oSrc.getCellByPosition(i, 0).String
Next i
MsgBox "Weather summaries built successfully." ' 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 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))
Function SheetExists(sheetName As String) As Boolean For i = LBound(origHeaders) To UBound(origHeaders)
Dim oSheets As Object, oSheet As Object h = Trim(origHeaders(i))
oSheets = ThisComponent.Sheets
On Error Resume Next ' Simple pattern-based cleanup
oSheet = oSheets.getByName(sheetName) h = Replace(h, "PWS-WU Avg Max Temp (degF)", "PWS-WU Max")
SheetExists = (Err = 0) h = Replace(h, "PWS-WU Avg Temp (degF)", "PWS-WU Avg")
On Error GoTo 0 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 End Function
Sub CopyColumnData(srcSheet As Object, srcCol As Long, srcHeaderRow As Long, _ '========================
destSheet As Object, destCol As Long, destHeaderRow As Long, _ ' FormatSummaryTables
srcStartRow As Long, srcEndRow As Long) '========================
Dim r As Long ' Formats each summary table in order from the top of the Summary sheet,
Dim srcCell As Object, destCell As Object ' without hardcoding category names. Assumes each table is:
Dim headerText As String ' Title row (R)
' Header row (R+1)
srcCell = srcSheet.getCellByPosition(srcCol, srcHeaderRow - 1) ' Data rows (12) (R+2 .. R+13)
headerText = srcSheet.Name & " " & srcCell.String ' Blank spacer (R+14)
destSheet.getCellByPosition(destCol, destHeaderRow).String = headerText Sub FormatSummaryTables()
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 oDoc As Object, oSheet As Object
Dim outRow As Long Dim rowPtr As Long, lastCol As Long
Dim i As Long, j As Long Dim j As Long, iRow As Long
Dim iRow As Long
Dim cell As Object Dim cell As Object
Dim rangeStart As Long, rangeEnd As Long Dim headerRow As Long, dataStart As Long, dataEnd As Long
Dim categories() As String
Dim lastCol As Long
oDoc = ThisComponent oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary") oSheet = oDoc.Sheets.getByName("Summary")
categories = Array("Temp", "Solar Radiation", "Wind", "Wind Direction", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days") rowPtr = 0
outRow = 0 Do While Trim(oSheet.getCellByPosition(0, rowPtr).String) <> ""
For i = LBound(categories) To UBound(categories)
' Title row ' Title row
cell = oSheet.getCellByPosition(0, outRow) cell = oSheet.getCellByPosition(0, rowPtr)
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.CharHeight = 12 cell.CharHeight = 12
cell.CellBackColor = RGB(255, 255, 255) cell.CellBackColor = RGB(255, 255, 255)
outRow = outRow + 1
' Find last used column in header row ' Header row
headerRow = rowPtr + 1
lastCol = 0 lastCol = 0
For j = 0 To oSheet.Columns.Count - 1 Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
cell = oSheet.getCellByPosition(j, outRow) lastCol = lastCol + 1
If Trim(cell.String) = "" Then Exit For Loop
lastCol = j lastCol = lastCol - 1
Next j If lastCol < 0 Then Exit Do
' Header row formatting
For j = 0 To lastCol For j = 0 To lastCol
cell = oSheet.getCellByPosition(j, outRow) cell = oSheet.getCellByPosition(j, headerRow)
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.IsTextWrapped = True 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.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 Next j
' Data rows formatting ' Data rows (next 12)
rangeStart = outRow + 1 dataStart = headerRow + 1
rangeEnd = outRow + 12 ' assuming 12 months data rows dataEnd = dataStart + 11
For iRow = dataStart To dataEnd
For iRow = rangeStart To rangeEnd
For j = 0 To lastCol For j = 0 To lastCol
cell = oSheet.getCellByPosition(j, iRow) cell = oSheet.getCellByPosition(j, iRow)
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
' No rounding here — NumberFormat is inherited from source
Next j Next j
Next iRow Next iRow
outRow = rangeEnd + 2 ' Advance to next table (skip 12 data rows + header + blank spacer)
Next i rowPtr = dataEnd + 2
Loop
MsgBox "Summary tables formatted." MsgBox "Summary tables formatted."
End Sub End Sub
Sub CreateChartsFromSummary() Sub CreateChartsFromSummary()
Dim oDoc As Object, oSheet As Object, oCharts As Object Dim oDoc As Object, oSheet As Object, oCharts As Object
Dim categories() As String, chartNames() As String Dim categories(), chartNames()
Dim iCat As Integer, iRow As Long, foundRow As Long Dim iCat As Long, foundRow As Long, iRow As Long
Dim titleRow As Long, headerRow As Long Dim titleRow As Long, headerRow As Long, dataStartRow As Long, dataEndRow As Long
Dim dataStartRow As Long, dataEndRow As Long
Dim lastCol As Long Dim lastCol As Long
Dim chartRangeAddress As Object Dim chartRangeAddress As Object
Dim chartObj As Object, oChart As Object, oDiagram As Object Dim chartObj As Object, oChart As Object, oDiagram As Object
Dim chartPos As New com.sun.star.awt.Rectangle Dim chartPos As New com.sun.star.awt.Rectangle
' === Config ===
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days", "Solar Radiation") 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") 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 Dim chartWidth As Long, chartHeight As Long
chartWidth = 6.5 * inch chartWidth = 6.5 * inch
chartHeight = 6.5 * inch chartHeight = 6.5 * inch
Dim startX As Long, startY As Long, chartSpacing As Long Dim startX As Long, startY As Long, chartSpacing As Long
startX = 19 * 1000 ' approx. column T startX = 19 * 1000
startY = 1000 startY = 1000
chartSpacing = 9.5 * inch chartSpacing = 9.5 * inch
@@ -293,75 +197,56 @@ Sub CreateChartsFromSummary()
oSheet = oDoc.Sheets.getByName("Summary") oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts oCharts = oSheet.Charts
' === Remove ALL existing charts from the sheet === ' Remove existing charts
Do While oCharts.getCount() > 0 Do While oCharts.getCount() > 0
oCharts.removeByName(oCharts.getByIndex(0).Name) oCharts.removeByName(oCharts.getByIndex(0).Name)
Loop Loop
For iCat = LBound(categories) To UBound(categories) 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 foundRow = -1
For iRow = 0 To oSheet.Rows.Count - 1 For iRow = 0 To oSheet.Rows.Count - 1
If InStr(LCase(oSheet.getCellByPosition(0, iRow).String), LCase(category)) > 0 Then If InStr(oSheet.getCellByPosition(0, iRow).String, categories(iCat)) > 0 Then
foundRow = iRow foundRow = iRow
Exit For Exit For
End If End If
Next iRow Next iRow
If foundRow = -1 Then If foundRow = -1 Then GoTo NextCategory
MsgBox "Category '" & category & "' not found in Summary sheet."
GoTo NextCategory
End If
titleRow = foundRow titleRow = foundRow
headerRow = titleRow + 1 headerRow = titleRow + 1
dataStartRow = headerRow + 1 dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11 ' 12 months dataEndRow = dataStartRow + 11
' === Find last column in header row ===
lastCol = 0 lastCol = 0
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> "" Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1 lastCol = lastCol + 1
Loop Loop
lastCol = lastCol - 1 lastCol = lastCol - 1
If lastCol <= 0 Then If lastCol <= 0 Then GoTo NextCategory
MsgBox "No data columns found for " & category
GoTo NextCategory
End If
' === Chart range ===
chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress() chartRangeAddress = oSheet.getCellRangeByPosition(0, headerRow, lastCol, dataEndRow).getRangeAddress()
' === Position chart ===
chartPos.X = startX chartPos.X = startX
chartPos.Y = startY + (iCat * chartSpacing) chartPos.Y = startY + (iCat * chartSpacing)
chartPos.Width = chartWidth chartPos.Width = chartWidth
chartPos.Height = chartHeight chartPos.Height = chartHeight
' === Create chart ===
oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True) oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True)
chartObj = oCharts.getByName(chartNames(iCat)) chartObj = oCharts.getByName(chartNames(iCat))
oChart = chartObj.EmbeddedObject oChart = chartObj.EmbeddedObject
' === Set diagram to Line Chart ===
oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram") oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram")
oDiagram.Vertical = False oDiagram.Vertical = False
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
oChart.setDiagram(oDiagram) oChart.setDiagram(oDiagram)
' === White chart wall ===
On Error Resume Next On Error Resume Next
oDiagram.Wall.FillColor = RGB(255, 255, 255) oDiagram.Wall.FillColor = RGB(255, 255, 255)
On Error GoTo 0 On Error GoTo 0
' === Remove main title ===
oChart.HasMainTitle = False oChart.HasMainTitle = False
' === Legend settings ===
oChart.HasLegend = True oChart.HasLegend = True
If oChart.Legend.supportsService("com.sun.star.chart.ChartLegend") Then If oChart.Legend.supportsService("com.sun.star.chart.ChartLegend") Then
oChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM oChart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM
@@ -370,65 +255,14 @@ Sub CreateChartsFromSummary()
oChart.Legend.CharHeight = 8 oChart.Legend.CharHeight = 8
End If 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: NextCategory:
Next iCat Next iCat
MsgBox "Charts created with manual Y-axis scaling." MsgBox "Charts created."
End Sub 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
' Simple Round helper
Function Round(num, Optional decimals) Function Round(num, Optional decimals)
Dim factor Dim factor
If IsMissing(decimals) Then If IsMissing(decimals) Then