Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Заливка шрифта в разных диапазонах на разных листах
 
#1
01.09.2010 14:10:53
тема проста.  
одна кнопка на первом листе, которая будет делать следующее:  
- нажал, и на всех листах, в указанных диапазонах, шрифт станет черным.  
- нажал, и на тех же листах, в тех же диапазонах, шрифт- цвета стандартного фона(белым)  
 
Я предположил так:  
- нажал один раз -  
Sheets("1й лист").Range("D39:AI40").Font.ColorIndex = 0  
Sheets("2ой лист").Range("D21:AI22, D40:AI41").Font.ColorIndex = 0  
- нажал второй раз -  
Sheets("1й лист").Range("D39:AI40").Font.ColorIndex = 2  
Sheets("2ой лист").Range("D21:AI22, D40:AI41").Font.ColorIndex = 2  
 
... но правильно ли это, и как связать в макрос не знаю !
 
 
 
#2
01.09.2010 14:25:41
можно как-нибудь так
 
 
 
#3
01.09.2010 14:30:58
Или добавить счётчик со сбросом: нажатие увеличивает его значение на единичку, а потом сбрасывает. Проверяем значение счётчика и форматируем.
 
 
 
#4
01.09.2010 15:11:26
{quote}{login=webley}{date=01.09.2010 02:25}{thema=}{post}можно как-нибудь так{/post}{/quote}  
 
Спасибо.    
 
Юрий М.: "..счётчик со сбросом.." - я не знаю, счем это едят, но уверен это вкусно  :)
 
 
 
#5
01.09.2010 16:18:29
Вариант, не самый оптимальный.    
Давно не был на форуме, навыки теряю:( Но работает. Можно, кажется, без селектов, но надо искать как обратиться к автофигуре и изменять/сосчитывать ее свойства:)  
Игорь67  
 
Option Explicit  
Sub fontFormat()  
Dim flag As Boolean, str As String  
 
ActiveSheet.Shapes("knopkaFont").Select  
str = Selection.Characters.Text  
 
If str = "черный" Then  
Sheets("Лист1").Range("D39:AI40").Font.ColorIndex = 0  
Sheets("Лист2").Range("D21:AI22, D40:AI41").Font.ColorIndex = 0  
Selection.Characters.Text = "белый"  
Else  
Sheets("Лист1").Range("D39:AI40").Font.ColorIndex = 2  
Sheets("Лист2").Range("D21:AI22, D40:AI41").Font.ColorIndex = 2  
Selection.Characters.Text = "черный"  
End If  
 
Sheets("Лист1").Range("D39").Select  
 
End Sub  
 
Для создания кнопки - запустите 1 раз Макрос1  
Sub Макрос1()  
'создать кнопку  
'  
   ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 261#, 23.25, 99#, _  
       23.25).Select  
   Selection.ShapeRange.Fill.Transparency = 0#  
   Selection.ShapeRange.Line.Weight = 0.75  
   Selection.ShapeRange.Line.DashStyle = msoLineSolid  
   Selection.ShapeRange.Line.Style = msoLineSingle  
   Selection.ShapeRange.Line.Transparency = 0#  
   Selection.ShapeRange.Line.Visible = msoTrue  
   Selection.ShapeRange.Line.ForeColor.SchemeColor = 64  
   Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)  
   Selection.ShapeRange.Fill.Visible = msoTrue  
   Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44  
   Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.33  
   Selection.Characters.Text = "черный"  
   With Selection.Characters(Start:=1, Length:=6).Font  
       .Name = "Arial Cyr"  
       .FontStyle = "полужирный"  
       .Size = 11  
       .Strikethrough = False  
       .Superscript = False  
       .Subscript = False  
       .OutlineFont = False  
       .Shadow = False  
       .Underline = xlUnderlineStyleNone  
       .ColorIndex = xlAutomatic  
   End With  
   Selection.HorizontalAlignment = xlCenter  
   Selection.Name = "knopkaFont"  
   Range("G5").Select  
End Sub
 
 
 
#6
01.09.2010 16:37:39
{quote}{login=}{date=01.09.2010 04:18}{thema=}{post}Для создания кнопки - запустите 1 раз Макрос1  
Sub Макрос1()  
'создать кнопку  
'  
   ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 261#, 23.25, 99#, _  
       23.25).Select  
   Selection.ShapeRange.Fill.Transparency = 0#  
{/post}{/quote}  
 
НИФИГА СЕ, :0
 
 
 
#7
01.09.2010 17:12:15
{quote}{login=The_Prist}{date=01.09.2010 04:48}{thema=}{post}В общем-то, если оптимизировать и упростить, то создание кнопки может выглядеть так:  
 
Sub Макрос1()  
'создать кнопку  
   {/post}{/quote}  
 
ВОООО. Огромный Вам сенскс, джидай-макрос Прист.  
:))
 
 
 
#8
01.09.2010 17:13:14
Да не, ну такие сложности из-за пустяка. На стандартную кнопку:  
Public flag As Boolean  
Sub fontFormat()  
       Sheets("Лист1").Range("D39:AI40").Font.ColorIndex = Abs(flag) * 2  
       Sheets("Лист2").Range("D21:AI22, D40:AI41").Font.ColorIndex = Abs(flag) * 2  
   flag = Abs(flag) - 1  
   Sheets("Лист1").Range("D39").Select  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#9
01.09.2010 17:41:38
Re: The_Prist  
Всетаки странный макрос. Создаёт пирожек с надписью "чёрный",... но в чей огород этот камень, я так и не понял :).  
 
KuklP  
Благодаря этой [Sheets("Лист1").Range("D39:AI40").Select] строке, он (макрос) выделяет область, но зачем (ведь изменений шрифта не происходит) не понятно.
 
 
 
#10
01.09.2010 17:42:15
Еще короче, используя пример webley  
 
Sub test()  
Static c  
c = IIf(c = 0, 2, 0)  
       Sheets("Лист1").Range("A1:C5").Font.ColorIndex = c  
       Sheets("Лист2").Range("B2:C5, D4:G10").Font.ColorIndex = c  
End Sub
 
 
 
#11
01.09.2010 17:45:38
Переместил Public flag As Boolean куда нужно и заработало. Спасибо KuklP
 
 
 
#12
01.09.2010 17:51:22
{quote}{login=Казанский}{date=01.09.2010 05:42}{thema=}{post}Еще короче, используя пример webley  
 
{/post}{/quote}  
 
Я не стал уточнять такую деталь как, Диапазон, он всегда с D:AI. Меняются только номера строк.  
 
Этоя я к тому, что : А Можно еще короче? :)
 
 
 
#13
01.09.2010 18:04:07
Да, да Прист я всё прекрасно понимаю. "тема проста." - я бы сказал для тех, кто откликнулся (до этого сообщения) - семечки.  
Я просто описал, что получилось.  
 
И всётаки, лучший макрос от Казанского.  
Он избегает дублирования строк, что облегчает редактирование.  
Он меньше по размеру, а значит меньше файл.
 
 
 
#14
01.09.2010 18:25:49
Фига себе:)  
2 The_Prist,    
Макрос1 вообще был левый - только что бы не писать как сделать кнопку:) Файлы примеров у меня не пролазят:(    
А вот про ActiveSheet.DrawingObjects действительно забыл. Дома в копилке есть примеры, а искать времени небыло.
 
 
 
Страницы: 1
Читают тему
Наверх