Я написал макрос в StarBasic еще в 2004 году, который применяет чередующиеся цвета к используемым ячейкам (все еще работает с LO 5.2.2.2, который я использую на сегодняшний день). Я надеюсь, что источник хорошо документирован, чтобы вы могли найти определения цветов, если вы хотите их изменить ;-)
Скопируйте код в модуль в вашей стандартной библиотеке базового кода, чтобы он был доступен всем документам CALC.
НТН
'Copyright (c) 2004, 2016 Winfried Rohr, re-Solutions Software Test Engineering
'This program is free software; you can redistribute it and/or modify it under
'the terms of the GNU General Public License as published by the Free Software
'Foundation; either version 2 of the License, or (at your option) any later
'version.
'This program is distributed in the hope that it will be useful, but WITHOUT ANY
'WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
'A PARTICULAR PURPOSE. See the GNU General Public License for more details.
'You should have received a copy of the GNU General Public License along with
'this program; if not, write to the Free Software Foundation, Inc., 59 Temple
'Place, Suite 330, Boston, MA 02111-1307 USA
' ========================================================================
Dim oDoc
Dim lRows as Long
Dim lCols as Long
Dim lStartRow as Long
Dim i as Long
Dim lEvenColor, lOddColor as Long
Dim sModulName, sModulSubName, sModulVersion
' -------------------------------------------------------------------
Sub colorCalcTableRowsEnglish ' manual extension 2006-03-24
sModulName = "wr CALC Modul"
sModulSubName = "colorCalcTableRows"
sModulVersion = "20040810"
oDoc = ThisComponent
If Not oDoc.supportsService(_
"com.sun.star.sheet.SpreadsheetDocument" ) Then
MsgBox _
"Macro not called from CALC Document." & CHR(10) _
& CHR(10) & "Explanation:" _
& CHR(10) & "This Macro applies alternating, pre-definied" _
& CHR(10) & "background colors to the rows of the used cell"_
& CHR(10) & "range in CALC Documents and will only work there."_
& CHR(10) & CHR(10) _
& "Macro " & sModulSubName & " will terminate now." _
, 48 , sModulName & " " & sModulVersion
Exit Sub
End If
' RGB: Red/Green/Blue portion of color
' values could range from 0 to 255
' see Tools > OpenOffice.org > Colors for values
' 0,0,0: Black
' 255,255,255: White
'
' Even/Odd correspond to ROW number
lEvenColor = RGB(255,200,200) ' kinda red
lOddColor =RGB(188,188,188) ' grey
if oDoc.Sheets.Count > 1 then
' more than 1 sheet, ask if macro should work on all sheets
sQuestion = _
"Applying alternating background colors to used cell range."_
& CHR(10) _
& CHR(10) & "Should all sheets be affected?" _
& CHR(10) & "YES: apply on all sheets" _
& CHR(10) & "No: apply to actual sheet only"
iButton = _
MsgBox(sQuestion ,35, sModulSubName & " - " & sModulVersion)
Select Case iButton
Case 2 ' cancel
exit sub
Case 6 ' yes = all sheets
PROC_AllSheets
Case 7 ' no = actual sheet only
actSheet = oDoc.currentController.ActiveSheet
PROC_colorSheetRow(actSheet)
End Select
else
' only one sheet present
actSheet = oDoc.currentController.ActiveSheet
PROC_colorSheetRow(actSheet)
end if
End Sub
' -------------------------------------------------------------------
Sub PROC_allSheets
enumS = oDoc.getSheets.createEnumeration
While enumS.hasMoreElements
actSheet = enumS.nextElement()
PROC_colorSheetRow(actSheet)
Wend
End Sub
' -------------------------------------------------------------------
Sub PROC_colorSheetRow(actSheet)
lStartRow = 0
' watch out on first 4 rows if they might be formatted as heading
for i = 0 to 3
' don't touch rows with heading style
oCell = actSheet.getCellByPosition(0,i)
if INSTR(oCell.CellStyle , "Heading") > 0 then
' style heading found: increase start row
lStartRow = i + 1
end if
next i
' obtain last cell in sheet
vLastPos = FUNC_LastUsedCell(actSheet)
lRows = vLastPos(0)
lCols = vLastPos(1)
' if no more cell used - then nothing
if lRows = 0 AND lCols = 0 then
exit sub
end if
' not more than headings
if lStartRow > lRows then
exit sub
end if
' set range to one color (performance issue)
actRange = actSheet.getCellRangeByPosition(0,lStartRow,lCols,lRows)
actRange.setPropertyValue("CellBackColor", lEvenColor)
' now set color to Odd (number) rows (are even indexes)
for i = lStartRow to lRows
' determine range
actRange = actSheet.getCellRangeByPosition(0,i,lCols,i)
' only every second row
if((i MOD 2) = 0) then
' even index is odd row number
actRange.setPropertyValue("CellBackColor", lOddColor)
end if
next i
End Sub
' -------------------------------------------------------------------
' function uses variant array to return more than one value
Function FUNC_LastUsedCell(oSheet as Object) as Variant
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(TRUE)
oEndAdr = oCursor.getRangeAddress
Dim vLastUsedCell(1) as Variant
vLastUsedCell(0) = oEndAdr.EndRow
vLastUsedCell(1) = oEndAdr.EndColumn
FUNC_LastUsedCell = vLastUsedCell()
End Function
