chatgpt proposed for header simplification

This commit is contained in:
2025-08-15 20:00:01 +00:00
parent e0a74bd9af
commit 803fa1f7ba

View File

@@ -1,367 +1,252 @@
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² oDoc = ThisComponent
Const LY_TO_KWH = 0.011622 On Error Resume Next
oDoc.Sheets.getByName("Summary").dispose()
On Error GoTo 0
oDoc.Sheets.insertNewByName("Summary", 0)
oSummary = oDoc.Sheets.getByName("Summary")
' Categories to summarise ' Define category mapping
categories = Array( _ categories = Array( _
"Temp", _ "Monthly Avg Temp (degF)", _
"Wind Speed", _ "Monthly Avg Wind Speed (mph)", _
"Wind Direction", _ "Monthly Avg Rel Humidity (%)", _
"Rel Humidity", _ "Monthly Avg Total Liquid Precipitation (in)", _
"Avg Total Liquid Precipitation", _ "Monthly Rainy Days (>0.1"" Liquid Precipitation)", _
"Rainy Days", _ "Monthly Solar Radiation (kWh/m2/day)" _
"Solar Radiation" _
) )
' Positions: headers on row 23, data on rows 2637 srcSheets = Array( _
headerRow = 23 "PWS-WU Monthly", _
startRow = 26 "PWS-WU Monthly", _
endRow = 37 "PWS-WU Monthly", _
"PWS-WU Monthly", _
oDoc = ThisComponent "PWS-WU Monthly", _
oSheets = oDoc.Sheets "PWS-WU Monthly" _
)
' REF sheet for month names
If Not SheetExists("REF") Then
MsgBox "Reference sheet 'REF' not found! Cannot pull month abbreviations."
Exit Sub
End If
oRefSheet = oSheets.getByName("REF")
' Summary sheet create or clear
If Not SheetExists("Summary") Then
oSummary = oSheets.createByName("Summary", oSheets.Count)
oSheets.insertByName("Summary", oSummary)
End If
oSummary = oSheets.getByName("Summary")
oSummary.clearContents(1023)
' 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 Loop
Next row 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 "monthly" sheets ' Clean headers
For sheetIndex = 0 To oSheets.Count - 1 cleanedHeaders = CleanHeaders(headers, srcSheets(iCat))
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) ' Write headers
For i = 0 To lastCol
oSummary.getCellByPosition(i, outRow).String = cleanedHeaders(i)
Next i
Select Case category ' Copy data (assumes 12 months starting at row 1 in source)
Case "Temp" For r = 1 To 12
If InStr(headerLow, "avg") > 0 And InStr(headerLow, "temp") > 0 Then For i = 0 To lastCol
CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow oSummary.getCellByPosition(i, outRow + r).Value = oSrc.getCellByPosition(i, r).Value
outCol = outCol + 1 Next i
End If Next r
Case "Wind Speed" ' Next table
If InStr(headerLow, "wind") > 0 _ outRow = outRow + 12 + 2
And InStr(headerLow, "dir") = 0 _ Next iCat
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
End If
Next sheetIndex
' Move pointer below table
outRow = outRow + (endRow - startRow + 2) + 1
Next catIndex
MsgBox "Weather summaries built successfully."
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)
' 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
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
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 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", "Solar Radiation", "Wind", "Wind Direction", "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", "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
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 ' approx. column T
startY = 1000
chartSpacing = 9.5 * inch
oDoc = ThisComponent oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary") oSheet = oDoc.Sheets.getByName("Summary")
oCharts = oSheet.Charts
rowPtr = 0
' === Remove ALL existing charts from the sheet === Do While Trim(oSheet.getCellByPosition(0, rowPtr).String) <> ""
Do While oCharts.getCount() > 0 ' Title row
oCharts.removeByName(oCharts.getByIndex(0).Name) cell = oSheet.getCellByPosition(0, rowPtr)
Loop cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.CharHeight = 12
For iCat = LBound(categories) To UBound(categories) cell.CellBackColor = RGB(255, 255, 255)
Dim category As String
category = categories(iCat) ' Header row
headerRow = rowPtr + 1
' === Locate the table for this category (case-insensitive search in column 0) ===
foundRow = -1
For iRow = 0 To oSheet.Rows.Count - 1
If InStr(LCase(oSheet.getCellByPosition(0, iRow).String), LCase(category)) > 0 Then
foundRow = iRow
Exit For
End If
Next iRow
If foundRow = -1 Then
MsgBox "Category '" & category & "' not found in Summary sheet."
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 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 Exit Do
If lastCol <= 0 Then
MsgBox "No data columns found for " & category For j = 0 To lastCol
GoTo NextCategory cell = oSheet.getCellByPosition(j, headerRow)
End If cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
cell.IsTextWrapped = True
' === Chart range === 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() 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
@@ -369,66 +254,15 @@ Sub CreateChartsFromSummary()
oChart.Legend.Expansion = com.sun.star.chart.ChartLegendExpansion.WIDE oChart.Legend.Expansion = com.sun.star.chart.ChartLegendExpansion.WIDE
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