Оформление границ ячеек макросом.

[irina181]

Всем привет. С BVA не дружу, поэтому прошу помощи.
Алгоритм действий следующий:
- Активируем ячейку В7 происходит закрашивание вертикальных и горизонтальных границ ячеек в диапазоне А7:J7
- Активируем ячейку В8 происходит закрашивание вертикальных и горизонтальных границ ячеек в диапазоне А8:J8
Подобные манипуляции происходят в строках с 7 по 300.
Файл таблицы во вложении, макросы там уже имеются, к ним надо добавить, описанное выше.

[IgorGO]

все написано правильно, только
1. ничего активировать не нужно, работаем с диапазоном a7:j300
2. есть подозрения, что нужны не только горизонтальные и вертикальные границы, а еще: верхняя, нижняя, левая и правая (сомнительна только необходимость левой границы)

в итоге макрос, который сделает то, что Вы описали, будет выглядеть так:

Sub Bords()
  Dim b&
  For b = 7 To 12
    [a7:j300].Borders(b).Weight = xlThin
  Next
End Sub

[irina181]

Спасибо за быстрый ответ, но имелось в виду несколько не то. В результате работы Вашего макроса после активации В7 оформляются границы всего диапазона сразу, а я имел ввиду, что оформляться будут границы только в 7-й строке с А до J. Далее после ввода данных в В8 границы оформятся только в 8-й строке с А до J и так по нарастающей при заполнении строк в указанном диапазоне. И после добавления Вашего макроса в документ, у меня перестала работать нумерация в столбце А, вместо нумерации там появляется формула. Код я сделала так

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim b&
  For b = 7 To 12
    [a7:j300].Borders(b).Weight = xlThin
  Next

'Автонумерация
Range("A7:A" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IF(RC2="""","""",MAX(R1C1:R[-1]C)+1)"
  'переключение раскладки
    Select Case Target.Column    ' в зависимости от номера столбца активной ячеки
        Case 2:    ' для столбца Полис (серия)
            ВключитьАнглийскуюРаскладку
        Case 3:    'на столбце Полис (номер) включаем русскую раскладку клавы и далее всё на русском
            ВключитьРусскуюРаскладку
        Case Else:    ' ничего не делаем (оставляем текущую раскладку)
    End Select
'перемещение курсора по TAB
  Set PrevCell(0) = PrevCell(1)
  Set PrevCell(1) = Target
  If PrevCell(0) Is Nothing Then Exit Sub
  If Target.Column = 1 Then Exit Sub
  EnableEvents = False
  If Target.Column = TabEnd + 1 Then
    If PrevCell(0).Address = Target.Offset(0, -1).Address Then Cells(Target.Row + 1, TabStart).Select
    Set PrevCell(1) = ActiveCell
  End If
  EnableEvents = True
End Sub

[IgorGO]

на Планете написал Вам такой макрос

Sub BordsAJ(r&)
  Dim b&
  For b = 7 To 12
    range("a" & r & ":j" & r).Borders(b).Weight = xlThin
  Next
End Sub

а вот пример как его выполнить 294 раза (для строк с 7-й по 300)

Sub НарисоватьГраницыс7по300Строки
  dim i&
  for i = 7 to 300
    Bords(i)
  next
end sub

да, не подумайте чего... 7 в обоих случаях, это простое совпадение

[irina181]

Не знаю как это всё привязать в коде. Буду форматировать границы вручную.

[IgorGO]

рано впадать в отчаяние

If PrevCell(0) Is Nothing Then Exit Sub
If Target.Column = 1 Then Exit Sub
EnableEvents = False
Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Borders.LineStyle = xlContinuous
If Target.Column = TabEnd + 1 Then

[irina181]

Извините за мою бестолковость, но не соображаю я куда это всё в код скопировать. Не буду Вас мучать и сам успокоюсь. Работать будем по старинке. Спасибо за участие.

[IgorGO]

я привел фрагмент текста Вашей процедуры
синим цветом подкрашено то, что нужно вставить между строк в Вашей процедуре!
внимательнее, пожалуйста))

[irina181]

Извините ещё раз за мою бестолковть. Да так работает, но нарушилась моя автонумерация в столбце А. Вместо цифр в столбце А стала появляться просто формула (=IF(RC2="","",MAX(R1C1:R[-1]C)+1)) из кода. В чём проблема? Файл могу выслать.

[irina181]

Методом проб и ошибок решила свою проблему, вставив строку

Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Borders.LineStyle = xlContinuous

, вот в этот кусок кода

If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B7:B300")) Is Nothing Then
    Range(Cells(Target.Row, 1), Cells(Target.Row, 10)).Borders.LineStyle = xlContinuous
    With Application: .EnableEvents = False
    Target.Value = UCase(Target.Value)
    .EnableEvents = True: End With

из моего файла и все, поставленные ной условия выполняются. Вставка, вышеуказанной строки, в место, описанное ранее в постах, не выполняло мои условия. Файл во вложении, может кому-то пригодится.