Обрамление ячеек при помощи макроса [РЕШЕНО]

[BotExtraSens]

Доброго времени Суток!

Понадобилось написать в ручную код макроса для оформления ячеек (интересовал сам принцип)

который при вызове
1)обрамляет  определенные ячейки
2)Вводит в них значенийя
3)Перемещается в другую ячейку
4)Повторяет цикл (без Операторов Цикла)
  
На пробу, Выполнил с помощью инструмента запись макроса , результат оказался мало пригодным и громоздким.
Пришлось  общими усилиями с форумчанами, написать в ручную два других варианта :

1. вариант с Поддержкой VBA  

Код:

Global i As Integer                         ' Глобальная Переменная сохраняет свои значения даже после завершения макроса пишется выше скобки Sub
Global k As Integer

Option VBASupport 1                         ' Поддержка VBA
Option Compatible                            

   Sub Graf

       Dim oDoc as Object                     ' Dim - обьявление переменной oDoc   тип Object
       Dim oCell as Object                    ' Dim - обьявление переменной oCell  тип Object
       Dim oSheet as Object                   ' Dim - обьявление переменной oSheet тип Object
       dim document   as object
       dim dispatcher as object
  
      oDoc=ThisComponent                      ' Обращение к Текущему Открытому Документу
      oSheet = oDoc.sheets (2)                ' Обращение к № Листа Текущего Документа (Индекс 0 это первый Лист,Индекс 1 это Второй Лист и т.д)
      oCell = oSheet.getCellByPosition (i, k) ' Обращение к Ячейке на Листе   (первый индекс Столбец , второй индекс Строка) - Позицирование
      oCell.Value = i                         ' Присвоение Ячейке значения  числа i
      oCell = oSheet.getCellByPosition (i, k) ' Обращение к Ячейке на Листе   (первый индекс Столбец , второй индекс Строка) - Позицирование
      oCell.Value = k                         ' Присвоение Ячейке значения числа k
    
      i = i + 1                               ' Увеличение значений Глобальной переменой i на единицу , при каждом запуске макроса
      k = k + 1                               ' Увеличение значений Глобальной переменой k на единицу , при каждом запуске макроса
      
     oCell.CellBackColor = RGB(0, 255, 0)     ' Цвет Фона    (Зеленый)
     ocell.CharColor = RGB(255, 0, 0)         ' Цвет Шрифта (Красный).
     ocell.CharFontName = "Courier"           ' Шрифт ( Courier)
     ocell.CharFontName = "Bold"              ' Выделение шрифта ( Жирный)        
     ocell.CharHeight = 14                    ' Высота символов      

with Range(Cells(j, i), Cells(h, k)).Borders() '  Обрамление ячейки , в параметрах можно указать Borders(xlEdgeLeft)  только левая сторона  обрамления
        .LineStyle = xlContinuous
        .Weight = xlThin

End With

End Sub

помогал economist

2. вариант на родном StarBasic  

Код:

Global i As Integer                                     ' Глобальная Переменная сохраняет свои значения  
Global k As Integer                                     ' даже после завершения макроса пишется выше скобки Sub

Sub Test_Borders                                        ' Макрос Имя
  Dim oCell , oRange, oDoc, oSheets                     ' Переменные
  Dim TableBorder As New com.sun.star.table.TableBorder ' Переменные
  Dim aTopLine As New com.sun.star.table.BorderLine

  oDoc = ThisComponent                                  ' Обращение к Текущему Открытому Документу
  oSheets = oDoc.Sheets(2)                              ' Обращение к № Листа Текущего Документа (Индекс 0 это первый Лист,Индекс 1 это Второй Лист и т.д)
  oCell = oSheets.getCellByPosition(i, k)               ' Обращение к Ячейке на Листе   (первый индекс Столбец , второй индекс Строка) - Позицирование
  aBorder = oCell.TableBorder
  
  k = 2  
  i = i + 1                                             ' Увеличение значений Глобальной переменной (i) на одну единицу , при каждом запуске макроса
  
  aTopLine.OuterLineWidth = 20                          ' это толщина внешней линии в случае двойной рамки
  aTopLine.InnerLineWidth = 0                           ' это толщина внутренней линии в случае двойной рамки
  aTopLine.Color = 170000                               ' Цвет Линии
 
  aBorder.TopLine = aTopLine                            ' Обрамление Верхней линии Ячейки
  aBorder.BottomLine = aTopLine                         ' Обрамление Нижней линии Ячейки
  aBorder.LeftLine = aTopLine                           ' Обрамление Левой линии Ячейки
  aBorder.RightLine = aTopLine                          ' Обрамление Правой линии Ячейки
  aBorder.HorizontalLine = aTopLine                     ' Обрамление Горизонтальной линии Ячейки                  
  aBorder.VerticalLine = aTopLine                       ' Обрамление Вертикальной линии Ячейки
 
  oCell.CellBackColor = RGB(0, 255, 0)                  ' Фон ячейки                          (зеленый)
  oCell.CharColor = RGB(255, 0, 0)                      ' Цвет Чисел, Букв, Символов, Знаков  (красный).
  oCell.CharFontName = "Courier"                        ' Шрифт                                Courier
  oCell.CharFontName = "Bold"                           ' Выделение шрифта                     (Жирный)        
  oCell.CharHeight = 14                                 ' Высота Символов
  oCell.String = now                                    ' Функция вывод текущей даты и времени  
  oCell = oSheets.getCellByPosition(i, k+1)
oCell.Value = i                                ' Присвоение Ячейке значения глобальной Переменной (i) которое будет отображатся в ячейках
  oCell.TableBorder = aBorder
   oCell.IsTextWrapped = true                     ' фиксированная ширина ячейки значение (true) или false если не фиксированная

End Sub

помогал Bigor

От себя дописал варианты оформления
Возможно какому нибудь новичку пригодиться!

Всем Спасибо за помощь !!

[economist]

Если нужно кратко - то используем VBA в SB внутри LibreOffice:

Код:

Option VBASupport 1
Option Compatible

Sub BorderCell
With [B3].Borders() ' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
End sub

Документации по VBA - в Сети хоть отбавляй, но конкретно заработает ваш код или нет - проще попробовать, благо много букв для этого писать не нужно. Многие в Excel макрорекордят и копипастят в StarBasic. Константы  вида xl* поддерживаются не все, но то что нужно - в 60-80% случаев работает.  

[economist]

Если же документ уже существует, а не создается с нуля - обрамлялку проще реализовать Условным форматированием, то есть формулой, не прибегая к макросам вовсе. 

[BotExtraSens]

Если нужно кратко - то используем VBA в SB внутри LibreOffice:

Код:

Option VBASupport 1
Option Compatible

Sub BorderCell
With [B3].Borders() ' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
End sub

 

Документации по VBA - в Сети хоть отбавляй, но конкретно заработает ваш код или нет - проще попробовать, благо много букв для этого писать не нужно. Многие в Excel макрорекордят и копипастят в StarBasic. Константы  вида xl* поддерживаются не все, но то что нужно - в 60-80% случаев работает. 

Спасибо за Оперативный Ответ!
Код Рабочий !!

Возникло два вопроса по вашему коду:
1) есть ли возможность сделать обрамление не всей ячейки а только определенной стороны ( низ , верх , лево , право ) ?
2) код работает по диапазонам прописанным в ручную ! есть ли возможность  изменить диапазон привязать к глобальной переменной ?

[economist]

1) Да. With [rangename].Borders(xlEdgeLeft) - слева
xlEdgeTop - вверху
xlEdgeBottom - внизу
xlInsideVertical - внутри по вертикали итд

2) Да, вот так: Range(имяпеременной).Borders()
Имя переменной должно быть в данном случае строкой текста вида "$B$34:$E$34"

Если же переменная, скажем, rng является объектом типа Range - то тогда вообще 
просто: rng.Borders() и далее по тексту.

[BotExtraSens]

1) Да. With [rangename].Borders(xlEdgeLeft) - слева
xlEdgeTop - вверху
xlEdgeBottom - внизу
xlInsideVertical - внутри по вертикали итд

Отлично работает !

2) Да, вот так: Range(имяпеременной).Borders()Имя переменной должно быть в данном случае строкой текста вида "$B$34:$E$34"

Если же переменная, скажем, rng является объектом типа Range - то тогда вообще 
просто: rng.Borders() и далее по тексту.

Не совсем понял
Написал следущее
Range(i).Borders() ' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
   

With   [B3:R3].Borders(xlEdgeLeft)' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
        .LineStyle = xlContinuous
        .Weight = xlThin
End With

Сообщает о синтаксической ошибке  ....

[economist]

Range(i).Borders() - так писать нельзя, это часть конструкции With. Приведите макрос целиком.  

Код:

Option VBASupport 1
Option Compatible

Sub test
With [B3:R3].Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
End Sub

не вызывает синтаксической ошибки.

Еще раз повторюсь - важно понимать тип переменной i 
Добавьте в код строку print typename(i) и напишите что она вернёт.

Существует хорошая традиция объявлять "объектные" переменные следующим образом:
Dim i as Range
set i=Sheets(1).[B3:R4] 
print typename(i) ' вернет "Range"

 

 

[BotExtraSens]

Приведите макрос целиком.

Global i As Integer
Global k As Integer
Option VBASupport 1
Option Compatible                         

Sub Graf

       Dim oDoc as Object                   
       Dim oCell as Object                   
       Dim oSheet as Object                 
   
      oDoc=ThisComponent                     
      oSheet = oDoc.sheets (2)               
      oCell = oSheet.getCellByPosition (i, k)
      oCell.Value = i                       
      oCell = oSheet.getCellByPosition (i, k)
      oCell.Value = k                         
      i = i + 4
      k = k + 1

With    [B3:R3].Borders(xlEdgeLeft)' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
        Range(ik).Borders()
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
        print typename(i)  ' Показывает Тип Переменой Integer !
End Sub

В конце выдает ошибку:

Ошибка времени выполнения BASIC.
'1'

Type: com.sun.star.uno.RuntimeException
Message: Invalid Argument

[economist]

1) Этот код неправильный, он ставит в ячейку A1 (0, 0) - значение переменных i и k, которые тоже равны 0. Смысла сие не имеет:
oCell = oSheet.getCellByPosition (i, k)
oCell.Value = i                      
oCell = oSheet.getCellByPosition (i, k)
oCell.Value = k                  

2) Вам же нужно обвести рамками диапазон скажем  B3:R4. Его нужно подсунуть в конструкцию With
любым способом:
With [B3:R3].Borders()
With Range("B3:R3").Borders()
With Range(rng).Borders() ' если rng="B3:R3"
With rng.Borders() ' если rng это объект, присвоенный командой SET из поста #6

То есть макрос должен получить диапазон (Range), а вы ему даете 0, 0. Это можно считать координатами ячейки A1. если написать их через запятую: Range(i, k).Borders()

Чтобы понимать в какой строке ошибка - выполняйте макрос в режиме отладчика, построчно, нажимая на клавишу F8. Перед каждым непонятным случаем - не стесняйтесь добавлять в макрос строку выделяющую ячейки, с которыми что-то надо делать. Это очень просто:

[B3:R3].Select

Тогда, если расположить окно Calc и окно LibreOffice Basic рядом (еще лучше - на разных мониторах) - можно видеть что делает каждая строка кода в программе.  

У вас переменные i k - целочисленные Integer. Они могут обозначать одну ячейку, а не диапазон. Напишите что должен делать макрос. Из его кода - непонятно.

[BotExtraSens]

1) Этот код неправильный, он ставит в ячейку A1 (0, 0) - значение переменных i и k, которые тоже равны 0. Смысла сие не имеет:
oCell = oSheet.getCellByPosition (i, k)
oCell.Value = i                      
oCell = oSheet.getCellByPosition (i, k)
oCell.Value = k

Вы меня не поняли )
i и k глобальные переменные их значение не обнуляется!
значение которых увеличивается с каждым нажатием кнопки мыши (в моем макросе это можно проверить)
координаты Ячеек тоже привязаны к ним, поэтому при изменении k и i  их новые числовые значения прописываются в соседние ячейки ( у меня это работает )!!

Напишите что должен делать макрос. Из его кода - непонятно.

При нажатии кнопки должны появляться  новые Числовые значения и записываться в соседние ячейки с обрамлением 

в обрамлении ячеек , которое тоже должно переходить на соседние ячейки (как числовые значения) и обрамлять их.
Почему то не перемещаются (один раз пропечатывается и все ) в этом и проблема ........
Не могу понять почему на координаты Обрамлений ячеек со значением глобальных переменных не действует как нужно  ...
Пытаюсь найти решение

Написал вроде
With    [B3:R3].Borders(xlEdgeLeft)' можно [ИМЯ_ДИАПАЗОНА] или Range("B3")
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
with     Range("i:k").Borders(xlEdgeLeft)

вроде правильно но смещения бордюров ячейки нет (
в чем ошибка ?

[economist]

Попробуйте собрать имя диапазона с буквами столбцов, типа:  

with Range("B" & i & ":R" & k).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
end with

При каждом нажатии на кнопку и увеличении значений i и k  на единицу - макрос будет получать
новый диапазон B1:R1, B2:R2 итд. Соответственно левый край ячейки B1, B2 будет получать рамку, т.к. xlEdgeLeft 

[BotExtraSens]

Попробуйте собрать имя диапазона с буквами столбцов, типа:  

with Range("B" & i & ":R" & k).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
end with

Работает!
но опять же с привязкой к конкретному столбцу
Попробую уточнить  вместо конкретных столбцов можно прописать  дополнительно Глобальные переменные
например   [Range(j & i & h & k) ?

[economist]

Можно так

Range(Cells(j, i), Cells(h, k))

Нумерация строк и столбцов в Cells идет с 0,  то есть A1 - это Cells(0, 0) 

[BotExtraSens]

Можно так

Range(Cells(j, i), Cells(h, k))

Нумерация строк и столбцов в Cells идет с 0,  то есть A1 - это Cells(0, 0) 

Написал так
with Range((Cells(j,i), Cells(h,k)).Borders(xlEdgeLeft) 'Нумерация строк и столбцов в Cells идет с 0,  то есть A1 - это Cells(0, 0)
        .LineStyle = xlContinuous
        .Weight = xlThin
End With
система ругается пишет
Синтаксическая ошибка BASIC.
Непарные круглые скобки.

[economist]

Правильно система ругается, левых скобок вы поставили больше. Копируйте мой код из #12, он рабочий.  
И стоит обрезать мой комментарий, в коде он не нужен. Это то что после символа '