AOO 4.1.3 Calc
Если интервал ячеек (одну или несколько) вручную изменить "формат ячеек..." и сделать "обрамление" любой толщины, то макрос не работает.
Не устанавливаются\не убираются границы во всём интервале столбцов 0-13 в этой строке/строках
Если так же вручную обрамление убрать, то макрос снова работает.
Sub PaintSetkaB 'границы
oColor=1
PaintSetka (oColor)
end sub
Sub PaintSetkaW 'убрать границы
oColor=0
PaintSetka (oColor)
end sub
sub MakeTableBorder (bRange, borW(), oColorT()) 'границы
v = bRange.TableBorder
x = v.TopLine : x.OuterLineWidth = borW(1) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.TopLine = x
x = v.BottomLine : x.OuterLineWidth = borW(2) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.BottomLine = x
x = v.LeftLine : x.OuterLineWidth = borW(3) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.LeftLine = x
x = v.RightLine : x.OuterLineWidth = borW(4) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.RightLine = x
x = v.VerticalLine : x.OuterLineWidth = borW(5) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.VerticalLine = x
x = v.HorizontalLine : x.OuterLineWidth = borW(6) : x.color = RGB(oColorT(0),oColorT(1),oColorT(2)) : x.lineDistance = 0 : v.HorizontalLine = x
bRange.TableBorder = v
end sub
Sub PaintSetka (oColor As Integer) 'что и как ограничивать
Dim oRanges
Dim borW (8)
Dim oColorT(3)
'msgbox oColor
if oColor = 1 then
borW(0) = 19 '
borW(1) = 19 'верхняя гориз
borW(2) = 19 'нижняя гориз
borW(3) = 19 'левая вертик
borW(4) = 19 'правая вертик
borW(5) = 19 'внутри вертикальная
borW(6) = 19 'внутри горизонтальная
borW(7) = 19 '
borW(8) = 19 '
oColorT (0) = 0 : oColorT(1) =0 : oColorT (2) = 0
else
borW(0) = 0 '
borW(1) = 0 'верхняя гориз
borW(2) = 0 'нижняя гориз
borW(3) = 0 'левая вертик
borW(4) = 0 'правая вертик
borW(5) = 0 'внутри вертикальная
borW(6) = 0 'внутри горизонтальная
borW(7) = 0 '
borW(8) = 0 '
oColorT (0) = 255 : oColorT(1) =255 : oColorT (2) =255
end if
oDoc = ThisComponent
oSheet = oDoc.getCurrentController.getActiveSheet
SelectedItem = ThisComponent.getCurrentSelection()
oRange = SelectedItem
If IsNull(SelectedItem) Then
msgbox "Ничего не выбрано "
Exit Sub
end if
If SelectedItem.supportsService("com.sun.star.sheet.SheetCell") Then
oRow = thisComponent.getCurrentSelection.getRangeAddress.startRow
MakeTableBorder (oSheet.getCellRangeByPosition(0,oRow,13,oRow), borW(), oColorT())
ElseIf SelectedItem.supportsService("com.sun.star.sheet.SheetCellRange") Then
oRow = thisComponent.getCurrentSelection.getRangeAddress.startRow
for xxx=0 to SelectedItem.Rows.getCount() - 1
MakeTableBorder (oSheet.getCellRangeByPosition(0,oRow+xxx,13,oRow+xxx), borW(), oColorT())
next
ElseIf SelectedItem.supportsService("com.sun.star.sheet.SheetCellRanges") Then
'oRanges = SelectedItem
msgbox SelectedItem.getCount() -1
For i=0 To SelectedItem.getCount() -1
oRow = SelectedItem.getByIndex(i).getRangeAddress.startRow
'msgbox "область" & i+1 & " начальная строка " & oRow
oRows= SelectedItem.getByIndex(i).Rows '.getCount() - 1
'msgbox "область" & i+1 & " конечная строка " & SelectedItem.getByIndex(i).Rows.getCount() - 1
For nRow = oRow To oRow+oRows.getCount() - 1
MakeTableBorder (oSheet.getCellRangeByPosition(0,oRow+xxx,13,oRow+xxx), borW(), oColorT())
Next
Next
Else Print "Что-то еще выделеное = " & SelectedItem.getImplementationName()
End If
end sub