Reputation: 9
I have a range of cells named, with not contiguous cells (NOT rectangular range)
I need to assign a background value and color to each cell in this range.
In the macro, naming works. Is it possible to assign a background value and color to all cells in the range in one statement?
Otherwise, if I have to make a loop, how to write it? (what I wrote does not work:
Error PROPERTY OR METHOD NOT FOUND: GETROWS
Thank you for your help
sub addColorToNameGameBoard()
Dim myDocument As Object
Dim zoneOfNames As Object
Dim gameRangeName As String
Dim gameRangeNameCoordinates As String
Dim oCellAdress As New com.sun.star.table.CellAddress
myDocument = Thiscomponent
gameRangeNameCoordinates = "Feuille1.$B$5:$C$7~Feuille1.$D$4:$H$8"
gameRangeName = "plateauDeJeu"
zoneOfNames = myDocument.NamedRanges
If zoneOfNames.hasByName(gameRangeName) then
zoneOfNames.removeByName(gameRangeName)
end If
zoneOfNames.addNewByName(gameRangeName, gameRangeNameCoordinates ,oCellAdress,0)'
Dim myGameBoard as Object
myGameBoard = zoneOfNames.getByName(gameRangeName)
'KO myGameBoard.BackColor = rgb(255,0,0)
'myGameBoard.CellBackColor = RGB(100, 0 ,100)
Dim ReferredCells as Object
Dim aRangeAddress as Object
oReferredCells = myGameBoard.getReferredCells()
aRangeAddress = oReferredCells.getRangeAddress()
Dim oSheet As Object
oSheet = myDocument.getSheets().getByName("Feuille1") 'Sheet1
Dim oCellRange As Object
oCellRange = oSheet.getCellRangeByName(gameRangeName)
Dim myCell as Object
Dim i as long, j as long
For i = 0 To oCellRange.getRows().getCount()-1
For j = 0 To oCellRange.getColumns().getCount()-1
myCell = oCellRange.getCellByPosition(i,j)
myCell.setValue(4)
myCell.cellbackcolor = RGB(50,60,70)
Next j
Next i
End Sub
I tried different syntax to get number of rows and columns, nothing worked
Upvotes: 0
Views: 316
Reputation: 9
The solution I was looking for:
option vbasupport 1
Sub Main
dim myRange as object
myRange=range("B5:C7,D4:H8")
myRange.value="X"
' Xray myRange plante (boucle)
myRange.CellRange.CellBackColor= RGB(50,60,70)
End Sub
Upvotes: 0
Reputation: 9
doc = ThisComponent
sheet = doc.CurrentController.ActiveSheet
group = doc.createInstance("com.sun.star.sheet.SheetCellRanges")
Dim indexColumn as long, indexLine as long
range1 = sheet.getCellRangeByName("Feuille1.$B$5:$C$7")
range2 = sheet.getCellRangeByName("Feuille1.$D$4:$H$8")
group.addRangeAddress(range1.RangeAddress, False)
group.addRangeAddress(range2.RangeAddress, False)
MsgBox group.RangeAddressesAsString
For Each individualRange In group
For indexLine = 0 To individualRange.getRows().getCount()-1
For indexColumn = 0 To individualRange.getColumns().getCount()-1
myCell = individualRange.getCellByPosition(indexColumn,indexLine )
myCell.setValue(4)
myCell.cellbackcolor = RGB(50,60,70)
Next indexColumn
Next indexLine
Next individualRange
Upvotes: 0
Reputation: 2539
Changing the color of an entire range in one line is not difficult: specify the name of some style with the design you want for the range's .CellStyle
property, and the entire range will be instantly redrawn. The situation is a little worse with assigning a certain value to each cell. As explained in this answer - Libreoffice calc - how to write a same value into a range, you will have to use row and column loops. And the situation is very bad with the ranges that you described using the tilde - there are no built-in tools for processing such constructions. This means that you will have to process each part of the address separately. In general, the solution code could look like this:
sub nommerAireDeJeu()
Dim monDocument As Object
Dim zoneDeNoms As Object
Dim nomDeLaPlageDeJeu As String
Dim coordonneesDeLaPlageDeJeu As String
Dim oCellAdress As New com.sun.star.table.CellAddress
monDocument = Thiscomponent
coordonneesDeLaPlageDeJeu = "Feuille1.$B$5:$C$7~Feuille1.$D$4:$H$8"
nomDeLaPlageDeJeu = "plateauDeJeu"
zoneDeNoms = monDocument.NamedRanges
If zoneDeNoms.hasByName(nomDeLaPlageDeJeu) then
zoneDeNoms.removeByName(nomDeLaPlageDeJeu)
end If
zoneDeNoms.addNewByName(nomDeLaPlageDeJeu, coordonneesDeLaPlageDeJeu ,oCellAdress,0)'
Dim oStyleFamilies As Variant
Dim nouveauStyle As Variant
oStyles = monDocument.getStyleFamilies().getByName("CellStyles")
If Not oStyles.hasByName(nomDeLaPlageDeJeu) Then
nouveauStyle = monDocument.createInstance("com.sun.star.style.CellStyle")
nouveauStyle.ParentStyle = oStyles.getByIndex(0).getName() ' "Default"
oStyles.insertByName(nomDeLaPlageDeJeu, nouveauStyle)
nouveauStyle.setPropertyValue("CellBackColor", RGB(50,60,70) )
EndIf
Dim aAdresses As Variant
Dim aRanges As Variant, aRange As Variant, aRngData As Variant
Dim i As Long, j As Long, m As Long, n As Long
aAdresses = Split(coordonneesDeLaPlageDeJeu, "~")
For i = LBound(aAdresses) To UBound(aAdresses)
aRanges = monDocument.getSheets().getCellRangesByName(aAdresses(i))
For j = LBound(aRanges) To UBound(aRanges)
aRange = aRanges(j)
aRngData = aRange.getData()
For m = LBound(aRngData) To UBound(aRngData)
For n = LBound(aRngData(m)) To UBound(aRngData(m))
aRngData(m)(n) = 12345
Next n
Next m
aRange.setData(aRngData)
aRange.CellStyle = nomDeLaPlageDeJeu
Next j
Next i
End Sub
Upvotes: 0