Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выделение цветом строки с сохранением формата - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Выделение цветом строки с сохранением формата
mitox Дата: Четверг, 22.03.2018, 12:37 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
День добрый.
Я нашел интересный макрос который выделяет строку цветом заданным в ячейке а1 и при выделении иной ячейки формат предыдущей сохраняется. В спойлере комментарий разработчика:

Вот сам макрос
В модуль листа:
[vba]
Код
Private Sub Worksheet_Deactivate() 'если активируется другой лист и есть подсветка, то подсветка убирается
    Call restoreFill
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dataRng As Range ' диапазон данных таблицы
Dim rowRng As Range ' диапазон ячеек в строке таблицы для подсветки
Dim celRng As Range ' ячейки в диапазоне подсветки rowRng
Dim n As Integer
    Call restoreFill
    If Range("A1").Interior.ColorIndex = xlNone Then Exit Sub 'если подсветка отключена, то выход
    If Target.Count > 1 Then Exit Sub 'если выделено больше одной ячейки
    Set dataRng = Range(Cells(7, 2), Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1, _
    ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1)) ' диапазон данных таблицы, Cells(7, 2) - адрес (начало) диапазона данных таблицы
    If Not Intersect(Target, dataRng) Is Nothing Then 'если ячейка выделена в диапазоне данных таблицы
        Set rowRng = Intersect(dataRng, Target.EntireRow) 'строка таблицы с выделенной ячейкой в диапазоне данных таблицы
        ReDim saveColor(rowRng.Cells.Count) 'размерность массива = ширина таблицы + нулевой элемент массива для адреса диапазона подсветки
        n = 0
        saveColor(n) = rowRng.Address 'адрес диапазона подсветки в нулевой элемент массива
        For Each celRng In rowRng 'перебор ячеек в диапазоне подсветки
            n = n + 1 'номер следующего элемента массива
            saveColor(n) = celRng.Interior.ColorIndex 'индекс заливки текущей ячейки в массив
        Next celRng
        rowRng.Interior.ColorIndex = Range("A1").Interior.ColorIndex 'заливка диапазона подсветки цветом заливки ячейки А1
        Target.Interior.ColorIndex = xlNone 'выделенная ячейка без заливки
    End If
    End Sub

Sub restoreFill() 'проверка включения подсветки, если подсветка была включена, то восстановление первоначальной (до подсветки) заливки в этой строке
Dim c As Integer
Dim cel_InRng As Range ' ячейки в диапазоне подсветки rowRng
    If (Not Not saveColor) <> 0 Then 'если массив не пустой (так проверяется массив, объявленный как Dim saveColor() ), т.е. диапазон подсветки был определен ранее
        c = 0
        For Each cel_InRng In Range(saveColor(0)) 'перебор ячеек в диапазоне, указанном в нулевом элементе массива
            c = c + 1 'номер следующего элемента массива
            cel_InRng.Interior.ColorIndex = saveColor(c) 'заливка ячеек цветами, сохраненными в массиве
        Next cel_InRng
        Erase saveColor 'удаление массива
    Else
        Exit Sub
    End If
End Sub
[/vba]
В модуль книги:
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveSheet.Name = "Имя листа с таблицей" Then Call Sheets("Имя листа с таблицей").restoreFill  
End Sub
[/vba]
В стандартный модуль:
[vba]
Код
Public saveColor() ' адрес подсвечиваемого диапазона и сохраненные цвета заливки подсвечиваемых ячеек таблицы до подсветки
[/vba]
Проверил его на своем файле - работает, но:
- почему то выделение идет инвертированным цветом, а не заданным в ячейке а1
- цвет выделенных ячеек после выделения меняется на иной
(см. файл)
Помогите пожалуйста устранить эти проблемы
А также как его доработать чтобы выделение работало на всех листах файла
К сообщению приложен файл: 9391226.zip (91.1 Kb)
 
Ответить
СообщениеДень добрый.
Я нашел интересный макрос который выделяет строку цветом заданным в ячейке а1 и при выделении иной ячейки формат предыдущей сохраняется. В спойлере комментарий разработчика:

Вот сам макрос
В модуль листа:
[vba]
Код
Private Sub Worksheet_Deactivate() 'если активируется другой лист и есть подсветка, то подсветка убирается
    Call restoreFill
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dataRng As Range ' диапазон данных таблицы
Dim rowRng As Range ' диапазон ячеек в строке таблицы для подсветки
Dim celRng As Range ' ячейки в диапазоне подсветки rowRng
Dim n As Integer
    Call restoreFill
    If Range("A1").Interior.ColorIndex = xlNone Then Exit Sub 'если подсветка отключена, то выход
    If Target.Count > 1 Then Exit Sub 'если выделено больше одной ячейки
    Set dataRng = Range(Cells(7, 2), Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1, _
    ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1)) ' диапазон данных таблицы, Cells(7, 2) - адрес (начало) диапазона данных таблицы
    If Not Intersect(Target, dataRng) Is Nothing Then 'если ячейка выделена в диапазоне данных таблицы
        Set rowRng = Intersect(dataRng, Target.EntireRow) 'строка таблицы с выделенной ячейкой в диапазоне данных таблицы
        ReDim saveColor(rowRng.Cells.Count) 'размерность массива = ширина таблицы + нулевой элемент массива для адреса диапазона подсветки
        n = 0
        saveColor(n) = rowRng.Address 'адрес диапазона подсветки в нулевой элемент массива
        For Each celRng In rowRng 'перебор ячеек в диапазоне подсветки
            n = n + 1 'номер следующего элемента массива
            saveColor(n) = celRng.Interior.ColorIndex 'индекс заливки текущей ячейки в массив
        Next celRng
        rowRng.Interior.ColorIndex = Range("A1").Interior.ColorIndex 'заливка диапазона подсветки цветом заливки ячейки А1
        Target.Interior.ColorIndex = xlNone 'выделенная ячейка без заливки
    End If
    End Sub

Sub restoreFill() 'проверка включения подсветки, если подсветка была включена, то восстановление первоначальной (до подсветки) заливки в этой строке
Dim c As Integer
Dim cel_InRng As Range ' ячейки в диапазоне подсветки rowRng
    If (Not Not saveColor) <> 0 Then 'если массив не пустой (так проверяется массив, объявленный как Dim saveColor() ), т.е. диапазон подсветки был определен ранее
        c = 0
        For Each cel_InRng In Range(saveColor(0)) 'перебор ячеек в диапазоне, указанном в нулевом элементе массива
            c = c + 1 'номер следующего элемента массива
            cel_InRng.Interior.ColorIndex = saveColor(c) 'заливка ячеек цветами, сохраненными в массиве
        Next cel_InRng
        Erase saveColor 'удаление массива
    Else
        Exit Sub
    End If
End Sub
[/vba]
В модуль книги:
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveSheet.Name = "Имя листа с таблицей" Then Call Sheets("Имя листа с таблицей").restoreFill  
End Sub
[/vba]
В стандартный модуль:
[vba]
Код
Public saveColor() ' адрес подсвечиваемого диапазона и сохраненные цвета заливки подсвечиваемых ячеек таблицы до подсветки
[/vba]
Проверил его на своем файле - работает, но:
- почему то выделение идет инвертированным цветом, а не заданным в ячейке а1
- цвет выделенных ячеек после выделения меняется на иной
(см. файл)
Помогите пожалуйста устранить эти проблемы
А также как его доработать чтобы выделение работало на всех листах файла

Автор - mitox
Дата добавления - 22.03.2018 в 12:37
mitox Дата: Пятница, 23.03.2018, 05:52 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Попробовал сам второй раз поразбираться как умею.
Понял что макрос работает на всех листах если скопировать на эти листы макросы, но тогда вопрос: Для чего эта часть вставлена в модуль?
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveSheet.Name = "Имя листа с таблицей" Then Call Sheets("Имя листа с таблицей").restoreFill  
End Sub
[/vba]

Ну и как избавиться от инвертирования цвета и почему цвет изменяется на иной после ухода с ячейки?

Пжалста - подскажите
 
Ответить
СообщениеПопробовал сам второй раз поразбираться как умею.
Понял что макрос работает на всех листах если скопировать на эти листы макросы, но тогда вопрос: Для чего эта часть вставлена в модуль?
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ActiveSheet.Name = "Имя листа с таблицей" Then Call Sheets("Имя листа с таблицей").restoreFill  
End Sub
[/vba]

Ну и как избавиться от инвертирования цвета и почему цвет изменяется на иной после ухода с ячейки?

Пжалста - подскажите

Автор - mitox
Дата добавления - 23.03.2018 в 05:52
mitox Дата: Пятница, 23.03.2018, 05:55 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Так понял что этот модуль видимо предотвращает сохранение цвета в последней выделенной ячейке при сохранении и закрытии файла. Как его переписать что бы он работал для всех листов книги?
 
Ответить
СообщениеТак понял что этот модуль видимо предотвращает сохранение цвета в последней выделенной ячейке при сохранении и закрытии файла. Как его переписать что бы он работал для всех листов книги?

Автор - mitox
Дата добавления - 23.03.2018 в 05:55
mitox Дата: Пятница, 23.03.2018, 06:03 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Разобрался методом перевода терминов, предположений и отсечения лишнего. Если модуль переписать вот так - то проблема сохранения цвета исчезает.
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Call ActiveSheet.restoreFill
End Sub
[/vba]

Я сам ))) Помогите пжалста разобраться с инверсией цвета. В оригинале все работает, на моем файле происходит замена цвета
 
Ответить
СообщениеРазобрался методом перевода терминов, предположений и отсечения лишнего. Если модуль переписать вот так - то проблема сохранения цвета исчезает.
[vba]
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Call ActiveSheet.restoreFill
End Sub
[/vba]

Я сам ))) Помогите пжалста разобраться с инверсией цвета. В оригинале все работает, на моем файле происходит замена цвета

Автор - mitox
Дата добавления - 23.03.2018 в 06:03
mitox Дата: Пятница, 23.03.2018, 06:08 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Да, и видимо нужно еще найти строчку макроса которая разрешает макросу раскрашивать ячейки при защите листа. Но это не в рамках этой темы


Сообщение отредактировал mitox - Пятница, 23.03.2018, 06:25
 
Ответить
СообщениеДа, и видимо нужно еще найти строчку макроса которая разрешает макросу раскрашивать ячейки при защите листа. Но это не в рамках этой темы

Автор - mitox
Дата добавления - 23.03.2018 в 06:08
Pelena Дата: Пятница, 23.03.2018, 08:04 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19603
Репутация: 4660 ±
Замечаний: ±

Excel 365 & Mac Excel
как избавиться от инвертирования цвета

Попробуйте вместо ColorIndex использовать Color
ColorIndex имеет ограниченное число цветов, поэтому берёт ближайшее значение, а не точное.


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
как избавиться от инвертирования цвета

Попробуйте вместо ColorIndex использовать Color
ColorIndex имеет ограниченное число цветов, поэтому берёт ближайшее значение, а не точное.

Автор - Pelena
Дата добавления - 23.03.2018 в 08:04
mitox Дата: Пятница, 23.03.2018, 11:38 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 26
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо. за совет - так и есть. Замена сняла обе проблемы.
 
Ответить
СообщениеСпасибо. за совет - так и есть. Замена сняла обе проблемы.

Автор - mitox
Дата добавления - 23.03.2018 в 11:38
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2026 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!