Цвет ярлычка excel vba - Word и Excel - помощь в работе с программами

Изменение цвета ярлыков листов

	09.12.2013, 14:44
[ Файл-пример (68.5 Kb) ]

В примере ярлык листа с названием «Лист1» станет черным, ярлык второго листа книги станет красным, третьего листа — желтым: Sub ChangeTabColor() ThisWorkbook.Worksheets("Лист1").Tab.ColorIndex = 1 ThisWorkbook.Worksheets(2).Tab.Color = vbRed ThisWorkbook.Worksheets(3).Tab.Color = RGB(255, 255, 0) End Sub Удалить раскраску ярлыков листов во всей книге можно так: Sub ClearTabColor() Dim ws As Worksheet For Each ws In Worksheets ws.Tab.ColorIndex = xlColorIndexNone Next ws End Sub
1 2 3 4 5 Добавил: Serge_007 \| \| Теги: ярлыки листов, vba, ВБА, цвет ярлыка листа
Просмотров: 10468 \| Рейтинг: 5.0/1

Всего комментариев: 4
Порядок вывода комментариев: Здравствуйте! Подскажите пожалуйста, а если в книге много листов их все надо перечислять в ThisWorkbook.Worksheets ? Может есть какое-то условие, которое проверяет сколько листов в книге и все их раскрашивает?

Добавлять комментарии могут только зарегистрированные пользователи.

[

Регистрация

Вход

]

Источник

wertual Пользователь Сообщений: 24 Регистрация: 22.02.2013	Добрый день! Изменение цвета ярлыка листа при каком либо условии вообще возможно? Если да, то как? Помогите пожалуйста.

Юрий М Модератор Сообщений: 60588 Регистрация: 14.09.2012 Контакты см. в профиле

Nic70y Пользователь Сообщений: 3289 Регистрация: 22.12.2012 Win7 MSO 2013	Ни чего в макросах не понимаю. Для интереса записал рекордерем (чуть изменил) работает: Прикрепленные файлы 800.xls (37 КБ)

wertual Пользователь Сообщений: 24 Регистрация: 22.02.2013	К сожалению, у меня ничего не получилось…

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

01.05.2013 00:39:35

Код
Sub Макрос1() If Range("A1") > 5 Then Sheets("Лист2").Tab.ColorIndex = 3 Else Sheets("Лист2").Tab.ColorIndex = xlNone End If End Sub

Если ячейка А1 активного листа > 5, то ярлычок второго листа заливаем красным. Иначе без заливки.

wertual Пользователь Сообщений: 24 Регистрация: 22.02.2013	Юрий М, Спасибо! ПОдскажите,а если значение текстовое, например «Да» или «НЕТ»?

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

01.05.2013 01:17:07

Код
If Range("A1") = "Да" Then

wertual Пользователь Сообщений: 24 Регистрация: 22.02.2013	C цифрами получается, а вот с текстом получается только в одну сторону: Если «да», то цвет меняет, а вот еслине да, то не меняет… Спасибо , что откликнулись! Этот форум очень полезен мне! Изменено: wertual — 01.05.2013 01:33:18

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

01.05.2013 01:37:21

Цитата
wertual пишет: C цифрами получается, а вот с текстом нет.

Не верю. А «на лету» — тоже макрос. См. пример: в ячейку А1 Лист1 вводим Да — второй ярлык будет красный, Нет — синий, любое другое значение — без заливки. Код в модуле листа.

Прикрепленные файлы

Цвет ярлычка.xls (23 КБ)

wertual

Пользователь

Сообщений: 24
Регистрация: 22.02.2013

нет, не работает, видимо у меня что-то не то с Excel… Даже Ваш файлик, за что Вам огромное спасибо, не работает,я его просто качаю, открываю, пишу да в желтой ячейке, а он ничего… ААА, оказывается я регистр не учел, все работает и прекрасно работает, большущая Вам благодарность!!!

Юрий М Модератор Сообщений: 60588 Регистрация: 14.09.2012 Контакты см. в профиле	Про регистронезависимость Вы ничего не говорили, а для Excel «Да» и «да» — разные вещи))

Добрый День Всем!!!
Данный макрос привязал к своему примеру. Все хорошо работает.
Только в моем примере нужно немного по другому реализовать.
Допустим есть выбор в ячейках А1:А6 из диапазона D1:D6. Нужно чтобы При выборе хотя бы одного параметра в ячейках А1:А6 выделялся цветом соответствующий этому параметру лист. Повторений в ячейках А1:А6 быть не может.
Файл примера прилагаю.
Макрос немного изменил, написал сначала для ячейки А1. Почти все работает. Только остается заливка цветом ярлычка предыдущего выбора.

Разобрался немного. Исправил макрос. Теперь при выборе из ячеек А1:А6 закрашиваются ярлычки соответствующих выбранных листов, но если какой либо параметр убираешь из ячеек А1:А6, то закрашенные листы все равно остаются. Не могу сообразить как дописать макрос, чтобы при отсутствии параметра в ячейках А1:А6 на соответствующем листе убиралось бы закрашивание ярлычка листа.
Файл переделанный прилагаю. Подскажите пожалуйста кто знает как сделать.

Юрий М Модератор Сообщений: 60588 Регистрация: 14.09.2012 Контакты см. в профиле

	Юрий, Спасибо большое! Все отлично работает! P.S.: только не могу понять как этот макрос работает.

	Не могу под свой пример этот макрос переписать. Например если перемещаю диапазон A1:A6 в колонку B, получается диапазон B1:B6 и меняю в макросе естественно на диапазон B1:B6, то макрос почему то перестает работать

k61

Пользователь

Сообщений: 2441
Регистрация: 21.12.2012

#17

22.08.2013 07:56:55

Для столба «B», в этой части кода Юрия исправьте 1 на 2:

Код
If Not IsEmpty(Cells(i, 1)) Then Sheets(Cells(i, 1).Value).Tab.ColorIndex = 3 End If

С этим да, я уже разобрался. Но почему то когда вставляю в свой пример, у меня выводит ошибку на строчку кода:
[CODE][/CODE] Sheets(Cells(i, 4).Value).Tab.ColorIndex = 3

А так впринципе листы закрашиваются даже с ошибкой… только не могу понять что за ошибка

k61 Пользователь Сообщений: 2441 Регистрация: 21.12.2012	Ну видимо листа с именем равным значению в ячейке Cells(i, 4) не существует. Почему Cells(i, 4).Value, если речь идёт о столбце «B» (втором)?

AlexZanderG

Пользователь

Сообщений: 41
Регистрация: 21.07.2013

#20

22.08.2013 08:32:40

Извините. да немного перепутал.
Допустим речь идет о столбце B. Но данные параметры находятся в ячейках B1, B6, B11, B16, B21, B26.
В других ячейках B2, B3 и т.д. находятся какие либо слова, по которым не надо проводить закрашивание листов.

Вот код я изменил немного.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1, B6, B11, B16, B21, B26")) Is Nothing Then
        
        For i = 2 To Sheets.Count
            Sheets(i).Tab.ColorIndex = xlNone
        Next
        For i = 1 To 26
            If Not IsEmpty(Cells(i, 2)) Then
                Sheets(Cells(i, 2).Value).Tab.ColorIndex = 3
            End If
        Next
    End If
End Sub

Но не знаю как поменять данную строчку кода чтоб он не по всем 26 строчкам считывал а только по данным (1, 6, 11, 16, 21, 26):

Код
For i = 1 To 26

Файл прилагаю так же.

Прикрепленные файлы

Цвет ярлычка 03.xls (44 КБ)

k61

Пользователь

Сообщений: 2441
Регистрация: 21.12.2012

#21

22.08.2013 08:49:14

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim sss()
If Target.Cells.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("B1, B6, B11, B16, B21, B26")) Is Nothing Then
  For i = 2 To Sheets.Count
  Sheets(i).Tab.ColorIndex = xlNone
  Next
  sss = Array("1", "6", "11", "16", "21", "26")
  For i = 0 To 5
    If Not IsEmpty(Cells(Val(sss(i)), 2)) Then
    Sheets(Cells(Val(sss(i)), 2).Value).Tab.ColorIndex = 3
    End If
  Next
End If
End Sub

	k61, спасибо большое Вам! все работает хорошо! Код понял как работает.

k61

Пользователь

Сообщений: 2441
Регистрация: 21.12.2012

#23

22.08.2013 09:09:38

Укоротим.

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Set rrr = Range("B1, B6, B11, B16, B21, B26")
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, rrr) Is Nothing Then
  For i = 2 To Sheets.Count
  Sheets(i).Tab.ColorIndex = xlNone
  Next
  For Each r In rrr
    If Not IsEmpty(r) Then
    Sheets(r.Value).Tab.ColorIndex = 3
    End If
  Next r
End If
End Sub

	Да, последний код будет универсальнее. Спасибо большое Вам!

sandiro

Пользователь

Сообщений: 27
Регистрация: 20.10.2015

Добрый день!
Подскажите новичку

На листе Лист1 в зависимости от результатов вычислений ячейки A1 и B1 окрашиваются обе в красный или зелёный цвет .
А можно ли сделать так что б цвет листа Лист1 окрашивался тем же цветом что и ячейки ?

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	sandiro, можно. С Вас файл-пример. <#0> Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

sandiro Пользователь Сообщений: 27 Регистрация: 20.10.2015	Вот пример Прикрепленные файлы Пример.xlsx (10.55 КБ)

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#28

28.10.2015 15:39:03

в модуле листа

Прикрепленные файлы

Пример (25).xlsb (15.55 КБ)

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

sandiro Пользователь Сообщений: 27 Регистрация: 20.10.2015

sandiro Пользователь Сообщений: 27 Регистрация: 20.10.2015	#30 29.10.2015 16:15:56 Тогда ещё спрошу… Есть Лист1 на нём три диапазона с данными B3 : B6 , C3 : C6 , D3 : D6 Если сумма значений в (B3 : B6) = (C3 : C6) + (D3 : D6) ярлык Лист1 был зелёного цвета, если не равно — красного Очень надо… Прикрепленные файлы Пример 222.xlsm (10.39 КБ)

Источник

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

Как автоматически выделить красным ярлычок листа в книге

22.01.2013, 02:29. Показов 4685. Ответов 14

Вот такая проблема.. Есть книга — в ней 140 листов таблиц с финданными (все заполнены однотипными таблицами).. некоторые в зависимости от задания заполняются, некоторые пустые.. Как можно средствами Экселя (2003) или с помощью макроса сделать так,чтобы например автоматически выделялся ярлычок листа красным цветом, если , допустим, ячейка A1 в листе содержит цифровую или текстовую информацию ? Как это можно сделать ?

Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

22.01.2013, 10:18

для одного листа

Visual Basic

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
If [A1] > "" Then Worksheets("Лист1").Tab.Color = 255
 End Sub

в модуль Лист1
если пройтись по всем листам, проверить, закрасить — то здесь моих знаний VBA маловато.
данный код можно вставить во все листы изменяя Лист1 на нужное название. Но лучше подождите появятся знатоки VBA напишут код сразу ля всех листов.

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

22.01.2013, 10:25

[ТС]

Спасибо, Но нужно как раз для всех листов

Казанский

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

22.01.2013, 10:28

Сообщение от Vlad999

данный код можно вставить во все листы…

Не надо, можно вставить в модуль книги

Visual Basic

1
2
3

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'...
End Sub

Но нужно ли вызывать эту процедуру при любом изменении в книге?
Может, лучше иметь в Personal макрос, который пробежит по листам текущей книги и установит цвет ярлычка?
И вызывать его по необходимости или перед сохранением книги (Sub Workbook_BeforeSave).

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

22.01.2013, 10:56

Не надо, можно вставить в модуль книги

Казанский а разве в 3 строка данного мной кода не нужно ничего менять? Имею ввиду
Worksheets(«Лист1«)
согласен что лучше код запускать вручную а не по проверке изменения на листе.

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

22.01.2013, 11:06

[ТС]

Да наверное с «Лист1» что надо делать.. просто с Sub Workbook_BeforeSave макрос не запускается..У меня 2003 ЭКсель !

Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

22.01.2013, 12:29

код на кнопку

Visual Basic

Sub заливка()
    Application.ScreenUpdating = False
For i = 1 To Sheets.Count
    Sheets(i).Activate
    If [A1] <> "" Then ActiveWorkbook.Sheets(i).Tab.Color = 255
Next
Application.ScreenUpdating = True
End Sub

Добавлено через 14 минут
хотя я так думаю нужно ещё добавить очистку если данные из А исчезли.

Казанский

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

22.01.2013, 12:45

Сообщение от Vlad999

а разве в 3 строка данного мной кода не нужно ничего менять? Имею ввиду
Worksheets(«Лист1»)

Конечно, надо.

Visual Basic

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Sh.Range("A1"), Target) Is Nothing Then _
    Sh.Tab.ColorIndex = IIf(Sh.Range("A1") = "", xlColorIndexNone, 3)
End Sub

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

24.01.2013, 01:17

[ТС]

Сообщение от Vlad999

Добавлено через 14 минут
хотя я так думаю нужно ещё добавить очистку если данные из А исчезли.

Да, тоже было бы неплохо иметь.. Типа если данные в ячейке (A1) исчезают, то ярлычок становится снова белым.. Если можно пришлите пример в экселевском файле на 2003 версию Excel.. что-то не запускается у меня макрос..

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

24.01.2013, 09:21

вставил код от Казанский

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

25.01.2013, 10:05

[ТС]

а как собственно говоря сам макрос в excel 2003 перенести..Я делаю так — кликаю правой кнопкой мыши на ярлычке затем сохраняю через экспорт в нужном файле, меняя номер ячейки, но он что-то отказывается работать.. может что-то не так делаю ? Спасибо большое..

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

25.01.2013, 10:25

Alt+F11 в окне слева находите ваш файл (если окна нет жмем Ctrl+R) а в нем «Эта книга» двойной клик — откроется код для книги. Выделяем копируем переходим в другую книгу там же слева открываем у него «Эта книга» вставляем.

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

25.01.2013, 11:02

[ТС]

Да. Все работает замечательно.. спасибо большое..а предыдущий пример не получается сделать ? , т.е. с одним макросом на 4 столбца на всю книгу с добавлением в диапазоны (4 диапазона) новых текстов.. или как можно сделать 4 отдельных макроса ?

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,932

25.01.2013, 11:08

Там я пас — моих знаний VBA недостаточно.

0 / 0 / 0

Регистрация: 23.09.2011

Сообщений: 61

25.01.2013, 13:14

[ТС]

Сообщение от Vlad999

Там я пас — моих знаний VBA недостаточно.

А Казанский может помочь ?

IT_Exp

Эксперт

87844 / 49110 / 22898

Регистрация: 17.06.2006

Сообщений: 92,604

25.01.2013, 13:14

Помогаю со студенческими работами здесь

Сохранение текущего листа с сохранением имени листа и присвоением новой книге имени текущего листа
Sub Save_as()
With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName =…

Как перенести данные с одного листа на другой в одной книге
Ребята, подскажите , пожалуйста, как перенести данные с одного листа на другой в одной книге,…

Тестер. Как выделить правильные ответы зелёным, а не правильные красным?
Здравствуйте программисты!! у меня такая проблема. Как можно сделать в режиме обучения:
1. Чтобы…

Как задать условие проверки того, что вводимое название листа уже есть в этой книге? (Да-да, я не шучу)
Простецкую лабу по VBA нужно усложнить тем, чтобы в случае того, что при создании листа расчета и…

Как в Excel создать правило, чтобы данные автоматически с одного листа на другой
Здравствуйте, подскажите пожалуйста, как прописать формулу?
в лист: "Результаты" постепенно…

Выделить прошедшую дату красным
Пожалуйста подскажите формулу для Условного форматирования

Задача: в приложенном файле надо…

Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:

Источник

Задача: Нужно програмно создать новый лист, при этом выдается запрос о его имени и цвете.

С именем пользую просто инпутбокс, а вот с выбором цвета ярлычка…
цвет меняется через
лист.tab.index = цвет
но он не подчиняется стандартной схеме RGB!
А выберается из константного набора около 20-30 цветов.
Когда просто из екселя меняешь цвет, то вылезает маленькое окошечко с этой палитрой.

Главный вопрос: как его вызвать программно?

ЗЫ: а еще заодно как вызвать стандартную палитру RGB?

5 ответов

275

19 марта 2006 года

pashulka

985 / / 19.09.2004

Код:

Application.CommandBars.FindControl(ID:=5747).Execute

16K

21 марта 2006 года

Dixon_Che

3 / / 13.03.2006

Цитата:

Originally posted by pashulka

Код:

Application.CommandBars.FindControl(ID:=5747).Execute

Спасибо большое!!!
А этот
ID:=5747
от версии офиса не зависит?

275

21 марта 2006 года

pashulka

985 / / 19.09.2004

Насколько мне известно этот идентификационный номер уникален, но он появился только в MS Excel XP, так как в более ранних версиях изменить цвет ярлычка было нельзя (средствами MS Excel) Но если возможен вариант, что версии приложений будут отличаться, то можно использовать что-то вроде :

Код:

With Application
If Val(.Version) >= 10 Then
.CommandBars.FindControl(ID:=5747).Execute
Else
MsgBox «В версии : » & .Version & vbCrLf & _
«невозможно вызвать диалоговое окно» & vbCrLf & _
«изменения цвета ярлычка», vbExclamation, «»
End If
End With

Код:

With Application
Set iFindControl = .CommandBars.FindControl(ID:=5747)

If Not iFindControl Is Nothing Then
iFindControl.Execute
Else
MsgBox «В версии : » & .Version & vbCrLf & _
«невозможно вызвать диалоговое окно» & vbCrLf & _
«изменения цвета ярлычка», vbExclamation, «»
End If
End With

16K

21 марта 2006 года

Dixon_Che

3 / / 13.03.2006

Цитата:

Originally posted by pashulka
Насколько мне известно этот идентификационный номер уникален, но он появился только в MS Excel XP, так как в более ранних версиях изменить цвет ярлычка было нельзя (средствами MS Excel) Но если возможен вариант, что версии приложений будут отличаться, то можно использовать что-то вроде :

Код:

With Application
If Val(.Version) >= 10 Then
.CommandBars.FindControl(ID:=5747).Execute
Else
MsgBox «В версии : » & .Version & vbCrLf & _
«невозможно вызвать диалоговое окно» & vbCrLf & _
«изменения цвета ярлычка», vbExclamation, «»
End If
End With

Код:

With Application
Set iFindControl = .CommandBars.FindControl(ID:=5747)

If Not iFindControl Is Nothing Then
iFindControl.Execute
Else
MsgBox «В версии : » & .Version & vbCrLf & _
«невозможно вызвать диалоговое окно» & vbCrLf & _
«изменения цвета ярлычка», vbExclamation, «»
End If
End With

Как исключительную ситуацию обработать я понял. FindControl ищет по номеру именно кнопоку которая запускает это окошко и уже как бы ее нажимает (я прально понимаю?)
Использовать так можно и понятно, а непосредственно само окошко вызвать без обращения к CommandBars.. а?

зы: Как ты это нашол?

275

22 марта 2006 года

pashulka

985 / / 19.09.2004

1. Всё правильно, метод .FindControl и .FindControls (MS Excel 2000) ищут CommandBarControl, только найденный контрол, может быть не только кнопкой.
2. Cтандартные диалоговые окна можно вызвать так :

Код:

Application.Dialogs(xlDialogWorkbookName).Show

Но вопрос, можно ли подобным образом, вызвать нужное Вам диалоговое окно, необходимо переадресовать владельцам MS Excel XP
3. Просто зашёл к людям, у которых установлен именно MS Excel XP и посмотрел нужный мне ID

Источник

Формулировка задачи:

как создать по средствам VBA процедуру, которая будет при каждом создании нового листа в Excel будет
перекрашивать ярлык созданного листа в случайный цвет?

Код к задаче: «VBA при каждом создании нового листа в Excel окрашивать ярлык»

textual

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Randomize
    Sh.Tab.ColorIndex = Int((55 * Rnd)) + 3
End Sub

Полезно ли:

15 голосов , оценка 4.200 из 5

Источник