Inherit source number formatting, align headers to bottom, add CreateChartsFromSummary Sub
This commit is contained in:
212
WeatherMacros
212
WeatherMacros
@@ -1,3 +1,8 @@
|
||||
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
|
||||
@@ -9,14 +14,15 @@ Sub BuildWeatherSummaries()
|
||||
|
||||
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
|
||||
|
||||
' UI rows: headers on row 23, data on rows 26–37
|
||||
headerRow = 23
|
||||
startRow = 26
|
||||
endRow = 37
|
||||
endRow = 37
|
||||
|
||||
oDoc = ThisComponent
|
||||
oDoc = ThisComponent
|
||||
oSheets = oDoc.Sheets
|
||||
|
||||
' Get REF sheet
|
||||
' Get REF sheet (for month abbreviations)
|
||||
If Not SheetExists("REF") Then
|
||||
MsgBox "Reference sheet 'REF' not found! Cannot pull month abbreviations."
|
||||
Exit Sub
|
||||
@@ -37,14 +43,14 @@ Sub BuildWeatherSummaries()
|
||||
For catIndex = LBound(categories) To UBound(categories)
|
||||
category = categories(catIndex)
|
||||
|
||||
' Write category title
|
||||
' Title
|
||||
oSummary.getCellByPosition(0, outRow).String = category & " Data Summary"
|
||||
outRow = outRow + 1
|
||||
|
||||
' Write month header
|
||||
' Month header
|
||||
oSummary.getCellByPosition(0, outRow).String = "Month"
|
||||
|
||||
' Fill months (Jan–Dec) from REF sheet, column A, rows 0 to 11 (adjust if needed)
|
||||
' Fill months (Jan–Dec) 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
|
||||
@@ -53,12 +59,13 @@ Sub BuildWeatherSummaries()
|
||||
|
||||
outCol = 1
|
||||
|
||||
' Scan all sheets for matching name
|
||||
' 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 ' limit to 100 columns max to avoid infinite loop
|
||||
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
|
||||
@@ -67,12 +74,13 @@ Sub BuildWeatherSummaries()
|
||||
|
||||
If category = "Temp" Then
|
||||
If InStr(headerLow, "avg") > 0 And InStr(headerLow, "temp") > 0 Then
|
||||
Call CopyColumnData(oSheet, col, oSummary, outCol, outRow, startRow, endRow)
|
||||
' 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
|
||||
Call CopyColumnData(oSheet, col, oSummary, outCol, outRow, startRow, endRow)
|
||||
CopyColumnData oSheet, col, headerRow, oSummary, outCol, outRow, startRow, endRow
|
||||
outCol = outCol + 1
|
||||
End If
|
||||
End If
|
||||
@@ -82,40 +90,61 @@ Sub BuildWeatherSummaries()
|
||||
End If
|
||||
Next sheetIndex
|
||||
|
||||
outRow = outRow + (endRow - startRow + 2) + 1 ' Skip past table with some space
|
||||
' 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."
|
||||
End Sub
|
||||
|
||||
' ==== Helpers ====
|
||||
|
||||
' Check if a sheet exists
|
||||
Function SheetExists(sheetName As String) As Boolean
|
||||
Dim oDoc As Object, oSheets As Object
|
||||
oDoc = ThisComponent
|
||||
oSheets = oDoc.Sheets
|
||||
SheetExists = False
|
||||
Dim i As Integer
|
||||
For i = 0 To oSheets.Count - 1
|
||||
If oSheets.getByIndex(i).Name = sheetName Then
|
||||
SheetExists = True
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
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
|
||||
End Function
|
||||
|
||||
Sub CopyColumnData(oSheet As Object, col As Long, oSummary As Object, outCol As Long, outRow As Long, startRow As Long, endRow As Long)
|
||||
Dim row As Long, dataCell As Object, headerCell As Object, header As String
|
||||
' 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)
|
||||
|
||||
headerCell = oSheet.getCellByPosition(col, 23 - 1)
|
||||
header = headerCell.String
|
||||
oSummary.getCellByPosition(outCol, outRow).String = oSheet.Name & " " & header
|
||||
Dim r As Long
|
||||
Dim srcCell As Object, destCell As Object
|
||||
Dim headerText As String
|
||||
|
||||
For row = startRow To endRow
|
||||
dataCell = oSheet.getCellByPosition(col, row - 1)
|
||||
oSummary.getCellByPosition(outCol, outRow + (row - startRow) + 1).Value = dataCell.Value
|
||||
Next row
|
||||
' 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 ====
|
||||
Sub FormatSummaryTables()
|
||||
Dim oDoc As Object, oSheet As Object
|
||||
Dim outRow As Long
|
||||
@@ -125,7 +154,6 @@ Sub FormatSummaryTables()
|
||||
Dim rangeStart As Long, rangeEnd As Long
|
||||
Dim categories() As String
|
||||
Dim lastCol As Long
|
||||
Dim cellContent As String
|
||||
|
||||
oDoc = ThisComponent
|
||||
oSheet = oDoc.Sheets.getByName("Summary")
|
||||
@@ -134,11 +162,11 @@ Sub FormatSummaryTables()
|
||||
outRow = 0
|
||||
|
||||
For i = LBound(categories) To UBound(categories)
|
||||
' Title row (e.g. "Temp Data Summary")
|
||||
' Title row
|
||||
cell = oSheet.getCellByPosition(0, outRow)
|
||||
cell.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
cell.CharHeight = 12
|
||||
cell.CellBackColor = RGB(255, 255, 255) ' white
|
||||
cell.CellBackColor = RGB(255, 255, 255)
|
||||
outRow = outRow + 1
|
||||
|
||||
' Find last used column in header row
|
||||
@@ -149,42 +177,132 @@ Sub FormatSummaryTables()
|
||||
lastCol = j
|
||||
Next j
|
||||
|
||||
' Header row (months + data series names)
|
||||
' 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.CENTER
|
||||
cell.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM ' <-- changed
|
||||
Next j
|
||||
|
||||
' Data rows (months + values)
|
||||
' 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)
|
||||
cellContent = Trim(cell.String)
|
||||
|
||||
' Only round numeric cells (leave month abbreviations and other text alone)
|
||||
If IsNumeric(cellContent) And cellContent <> "" Then
|
||||
cell.Value = Round(cell.Value, 1)
|
||||
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
|
||||
Else
|
||||
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
|
||||
End If
|
||||
cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
|
||||
' No rounding here — NumberFormat is inherited from source
|
||||
Next j
|
||||
Next iRow
|
||||
|
||||
' Skip rows for next category
|
||||
outRow = rangeEnd + 2
|
||||
Next i
|
||||
|
||||
MsgBox "Summary tables formatted."
|
||||
End Sub
|
||||
|
||||
Sub CreateChartsFromSummary()
|
||||
Dim i As Integer
|
||||
Dim iCat As Integer, iRow As Long
|
||||
Dim oDoc As Object, oSheet As Object
|
||||
Dim categories() As String
|
||||
Dim categoryColors() As Long
|
||||
Dim chartNames() As String
|
||||
Dim oCharts As Object
|
||||
Dim chartWidth As Long
|
||||
Dim posX As Long, posY As Long
|
||||
Dim outRow As Long
|
||||
Dim dataStartRow As Long, dataEndRow As Long
|
||||
Dim chartRangeAddress As Object
|
||||
Dim chartObj As Object
|
||||
Dim oChart As Object
|
||||
Dim oDiagram As Object
|
||||
|
||||
oDoc = ThisComponent
|
||||
oSheet = oDoc.Sheets.getByName("Summary")
|
||||
oCharts = oSheet.Charts
|
||||
|
||||
' Configurable
|
||||
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")
|
||||
chartWidth = 6500 ' approx 6.5 inch * 1000 (adjust if needed)
|
||||
posX = 1000
|
||||
posY = 500
|
||||
|
||||
outRow = 0
|
||||
|
||||
For iCat = LBound(categories) To UBound(categories)
|
||||
Dim category As String
|
||||
category = categories(iCat)
|
||||
|
||||
' Find category table start row
|
||||
Dim foundRow As Long
|
||||
foundRow = -1
|
||||
For iRow = outRow To oSheet.Rows.Count - 1
|
||||
If InStr(oSheet.getCellByPosition(0, iRow).String, category & " Data Summary") > 0 Then
|
||||
foundRow = iRow
|
||||
Exit For
|
||||
End If
|
||||
Next iRow
|
||||
If foundRow = -1 Then
|
||||
MsgBox "Category " & category & " not found."
|
||||
GoTo NextCategory
|
||||
End If
|
||||
|
||||
Dim titleRow As Long: titleRow = foundRow
|
||||
Dim headerRow As Long: headerRow = titleRow + 1
|
||||
dataStartRow = headerRow + 1
|
||||
dataEndRow = dataStartRow + 11 ' 12 months assumed
|
||||
|
||||
Dim lastCol As Long: lastCol = 0
|
||||
For i = 0 To oSheet.Columns.Count - 1
|
||||
If Trim(oSheet.getCellByPosition(i, headerRow).String) = "" Then Exit For
|
||||
lastCol = i
|
||||
Next i
|
||||
|
||||
If lastCol <= 0 Then
|
||||
MsgBox "No data columns found for " & category
|
||||
GoTo NextCategory
|
||||
End If
|
||||
|
||||
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
|
||||
|
||||
Dim chartPos As New com.sun.star.awt.Rectangle
|
||||
chartPos.X = posX
|
||||
chartPos.Y = posY + iCat * 7000
|
||||
chartPos.Width = chartWidth
|
||||
chartPos.Height = 20320
|
||||
|
||||
oCharts.addNewByName(chartNames(iCat), chartPos, Array(chartRangeAddress), True, True)
|
||||
chartObj = oCharts.getByName(chartNames(iCat))
|
||||
oChart = chartObj.EmbeddedObject
|
||||
|
||||
' Set chart type to line diagram
|
||||
oDiagram = oChart.createInstance("com.sun.star.chart.LineDiagram")
|
||||
oChart.setDiagram(oDiagram)
|
||||
|
||||
oChart.HasMainTitle = True
|
||||
oChart.Title.String = category & " Comparison"
|
||||
|
||||
oChart.HasLegend = True
|
||||
oChart.setPropertyValue("LegendPosition", com.sun.star.chart.ChartLegendPosition.BOTTOM)
|
||||
|
||||
outRow = dataEndRow + 2
|
||||
NextCategory:
|
||||
Next iCat
|
||||
|
||||
MsgBox "Charts created."
|
||||
End Sub
|
||||
|
||||
Function Round(num, Optional decimals)
|
||||
Dim factor
|
||||
If IsMissing(decimals) Then
|
||||
|
||||
Reference in New Issue
Block a user