Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.06.2012, 03:35   #1
Trimbl
Форумчанин
 
Регистрация: 11.08.2009
Сообщений: 135
По умолчанию Конфликт кодов

Подсмотрел тему « Как изменить цвет», из двух примеров любезно «выложенных» SAS888, слепил код . Но когда вставил его в модуль Эта Книга , где уже присутствует код для скрытия столбцов (две верхнии строки) редактор выдает Runtime error 424 Object required и ссылается на строку
.Borders(xlEdgeLeft).LineStyle = xlNone
В чем дело? Прошу помощи от знающих. Благодарю за внимание

Коды модуля ЭтаКнига
Private Sub Workbook_Open(): Run "Beg": End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean): Run "Ending": End Sub

Код изменения цвета границ выделенной ячейки
Dim OldCell As Range
Private Sub ColorIndex()
Set OldCell = ActiveCell
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
With Target
With .Borders(xlEdgeLeft): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
With .Borders(xlEdgeTop): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
With .Borders(xlEdgeBottom): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
With .Borders(xlEdgeRight): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
End With
With OldCell
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
End With
Set OldCell = Target
End Sub
Trimbl вне форума Ответить с цитированием
Старый 21.06.2012, 03:53   #2
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Ошибка из-за того, что это (как и последующие) свойство относится к ячейке OldCel, которая у Вас не определена. Для устранения ошибки, строку кода
Код:
Set OldCell = ActiveCell
переместите в макрос Workbook_Open(). Причем, строка Dim OldCell As Range должна быть первой строкой в модуле "Эта книга". После этого, сохраните, закройте и вновь откройте файл.
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 21.06.2012 в 04:05.
SAS888 вне форума Ответить с цитированием
Старый 21.06.2012, 04:29   #3
Trimbl
Форумчанин
 
Регистрация: 11.08.2009
Сообщений: 135
По умолчанию

SAS888, Спасибо конфликт исчез, но всплыло другое, а именно: При выборе ячеек существующей таблицы происходит уничтожение границ(линий) ячейки(диапазона).
Trimbl вне форума Ответить с цитированием
Старый 21.06.2012, 06:15   #4
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

При активации ячейки макрос меняет существующие границы на свои. При деактивации - уничтожает все границы.
Для того, чтобы границы не уничтожались, а восстанавливались, нужно их запоминать. Все возможные границы и их свойства запоминать ни к чему. Прикрепите Ваш файл с прорисованными границами (можно без значений ячеек) - посмотрим, как лучше сделать.
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 21.06.2012, 06:57   #5
Trimbl
Форумчанин
 
Регистрация: 11.08.2009
Сообщений: 135
По умолчанию

Вот файл, и еще - необходимо чтобы границы не менялись при скрытии и отображении столбцов
Вложения
Тип файла: rar Акт1.rar (36.3 Кб, 10 просмотров)
Trimbl вне форума Ответить с цитированием
Старый 22.06.2012, 09:39   #6
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Весь код в модуле "Эта книга" замените на следующий:
Код:
Dim OldCell As Range
Dim LinSt1 As Integer, LinSt2 As Integer, LinSt3 As Integer, LinSt4 As Integer
Dim Wgt1 As Integer, Wgt2 As Integer, Wgt3 As Integer, Wgt4 As Integer
Dim Clr1 As Integer, Clr2 As Integer, Clr3 As Integer, Clr4 As Integer
Private Sub Workbook_Open()
    Run "Beg"
    Set OldCell = ActiveCell
    RemBord OldCell
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean): Run "Ending": End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    With OldCell
        With .Borders(xlEdgeLeft): .Weight = Wgt1: .ColorIndex = Clr1: .LineStyle = LinSt1: End With
        With .Borders(xlEdgeTop):  .Weight = Wgt2: .ColorIndex = Clr2: .LineStyle = LinSt2: End With
        With .Borders(xlEdgeBottom):  .Weight = Wgt3: .ColorIndex = Clr3: .LineStyle = LinSt3: End With
        With .Borders(xlEdgeRight):  .Weight = Wgt4: .ColorIndex = Clr4: .LineStyle = LinSt4: End With
    End With
    RemBord Target
    With Target
        With .Borders(xlEdgeLeft): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
        With .Borders(xlEdgeTop): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
        With .Borders(xlEdgeBottom): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
        With .Borders(xlEdgeRight): .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = 8: End With
    End With
    Set OldCell = Target
End Sub
Sub RemBord(cell As Range)
    With cell
        Wgt1 = .Borders(xlEdgeLeft).Weight: Wgt2 = .Borders(xlEdgeTop).Weight
        Wgt3 = .Borders(xlEdgeBottom).Weight: Wgt4 = .Borders(xlEdgeRight).Weight
        Clr1 = .Borders(xlEdgeLeft).ColorIndex: Clr2 = .Borders(xlEdgeTop).ColorIndex
        Clr3 = .Borders(xlEdgeBottom).ColorIndex: Clr4 = .Borders(xlEdgeRight).ColorIndex
        LinSt1 = .Borders(xlEdgeLeft).LineStyle: LinSt2 = .Borders(xlEdgeTop).LineStyle
        LinSt3 = .Borders(xlEdgeBottom).LineStyle: LinSt4 = .Borders(xlEdgeRight).LineStyle
    End With
End Sub
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 23.06.2012, 02:28   #7
Trimbl
Форумчанин
 
Регистрация: 11.08.2009
Сообщений: 135
По умолчанию

Сразу, извиняюсь за назойливость, понимаю что, поднятая тема не так уж и важна для решения даже не глобальных задач, но "А" было произнесено, хотелось бы услышать и "Б". Благодарен SAS888 за решение, цветная ячейка действительно акцентирует внимание на рабочем листе, линии границ таблицы остаются первобытными при "хождении" по таблице.
Осталась неудолетворенность от:
1). В моем примере(Акт1) границы исчезают при скрытии столбцов(правая кнопка мышки)
2). Невозможно прорисовать границы ячейки при создании новой таблицы.
Прошу помощи у профи VBA.
Trimbl вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Конфликт кодов Brucebelg Microsoft Office Excel 3 10.02.2012 12:20
Конфликт перехвата? Fedor666 Общие вопросы C/C++ 0 27.11.2011 12:28
конфликт jquery johny_03 JavaScript, Ajax 1 18.11.2011 00:09
Конфликт IP Fellics{новичок} Компьютерное железо 3 30.12.2009 19:15
Конфликт версий? Bezdar Microsoft Office Excel 8 06.07.2009 17:44