brightside/Weather-Generator
1
0
Fork 0
Code Issues 10 Pull Requests Actions Packages Projects Releases Wiki Activity

add solar and separate wind tables, convert ly to kwh/m2 in solar table automatically

Browse Source
This commit is contained in:
brightside
2025-08-15 19:29:21 +00:00
parent 74c1422908
commit e0a74bd9af
1 changed files with 224 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files

218
WeatherMacros.bas
View File

@@ -4,7 +4,7 @@ Option Explicit
' ==== BuildWeatherSummaries ====
Sub BuildWeatherSummaries()
Dim oDoc As Object, oSheets As Object, oSheet As Object, oSummary As Object, oRefSheet As Object
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
@@ -12,9 +12,21 @@ Sub BuildWeatherSummaries()
Dim headerCell As Object
Dim outRow As Long
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
' Conversion constant from ly to kWh/m²
Const LY_TO_KWH = 0.011622
' UI rows: headers on row 23, data on rows 26–37
' 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 26–37
headerRow = 23
startRow = 26
endRow = 37
@@ -22,20 +34,20 @@ Sub BuildWeatherSummaries()
oDoc = ThisComponent
oSheets = oDoc.Sheets
' Get REF sheet (for month abbreviations)
' 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")
' Create or clear the Summary sheet
' 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) ' clear all
oSummary.clearContents(1023)
outRow = 0
@@ -43,14 +55,14 @@ Sub BuildWeatherSummaries()
For catIndex = LBound(categories) To UBound(categories)
category = categories(catIndex)
' Title
' Title row
oSummary.getCellByPosition(0, outRow).String = category & " Data Summary"
outRow = outRow + 1
' Month header
oSummary.getCellByPosition(0, outRow).String = "Month"
' Fill months (Jan–Dec) from REF sheet, column A, rows 0..11 (zero-based)
' 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
@@ -59,38 +71,66 @@ Sub BuildWeatherSummaries()
outCol = 1
' Scan all sheets whose name contains "monthly"
' 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 ' safety limit
' Read header text from the real header row (UI row 23 -> zero-based 22)
Do While col < 100
headerCell = oSheet.getCellByPosition(col, headerRow - 1)
header = Trim(headerCell.String)
If header = "" Then Exit Do
headerLow = LCase(header)
If category = "Temp" Then
Select Case category
Case "Temp"
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
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 If
End Select
col = col + 1
Loop
End If
Next sheetIndex
' Move output pointer below this table (+1 for header row +12 months)
' Move pointer below table
outRow = outRow + (endRow - startRow + 2) + 1
Next catIndex
@@ -99,7 +139,6 @@ End Sub
' ==== Helpers ====
' Check if a sheet exists
Function SheetExists(sheetName As String) As Boolean
Dim oSheets As Object, oSheet As Object
oSheets = ThisComponent.Sheets
@@ -109,41 +148,60 @@ Function SheetExists(sheetName As String) As Boolean
On Error GoTo 0
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
srcCell = srcSheet.getCellByPosition(srcCol, srcStartRow - 1 + r)
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
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
@@ -158,7 +216,7 @@ Sub FormatSummaryTables()
oDoc = ThisComponent
oSheet = oDoc.Sheets.getByName("Summary")
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
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)
@@ -205,6 +263,7 @@ Sub FormatSummaryTables()
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
@@ -217,8 +276,8 @@ Sub CreateChartsFromSummary()
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
Dim chartWidth As Long, chartHeight As Long
@@ -226,32 +285,34 @@ Sub CreateChartsFromSummary()
chartHeight = 6.5 * inch
Dim startX As Long, startY As Long, chartSpacing As Long
startX = 1000
startX = 19 * 1000 ' approx. column T
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 ALL existing charts from the sheet ===
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 ===
' === Locate the table for this category (case-insensitive search in column 0) ===
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(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."
MsgBox "Category '" & category & "' not found in Summary sheet."
GoTo NextCategory
End If
@@ -260,7 +321,7 @@ Sub CreateChartsFromSummary()
dataStartRow = headerRow + 1
dataEndRow = dataStartRow + 11 ' 12 months
' Find last column in header row
' === Find last column in header row ===
lastCol = 0
Do While Trim(oSheet.getCellByPosition(lastCol, headerRow).String) <> ""
lastCol = lastCol + 1
@@ -272,13 +333,9 @@ Sub CreateChartsFromSummary()
GoTo NextCategory
End If
' === Chart range ===
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)
@@ -292,10 +349,15 @@ Sub CreateChartsFromSummary()
' === 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)
' === White chart wall ===
On Error Resume Next
oDiagram.Wall.FillColor = RGB(255, 255, 255)
On Error GoTo 0
' === Remove main title ===
oChart.HasMainTitle = False
@@ -304,29 +366,69 @@ Sub CreateChartsFromSummary()
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))
' === 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
outRow = dataEndRow + 2
NextCategory:
Next iCat
MsgBox "Charts created with requested formatting."
MsgBox "Charts created with manual Y-axis scaling."
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
Function Round(num, Optional decimals)
Dim factor
If IsMissing(decimals) Then