|
Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2010 - [решено] Выделить часть текста цветом в ячейке по шаблону на всем листе |
|
2010 - [решено] Выделить часть текста цветом в ячейке по шаблону на всем листе
|
Старожил Сообщения: 329 |
Всем доброго вечера.
Есть интересная задача. Нужно выделить часть текста в ячейке которая запрашивается у пользователя. Как себе это вижу я: 1) спрашиваем шаблон и цвет у юзера 2) присваиваем переменной и считаем длину (дальше пригодится) 3)цикл поиска на присутствие в ячейках шаблона(не в пустых ячейках) 4)считаем какой по счету символ начинается шаблон в найденой ячейке 5)дальше выполняем окрашивание в цвет(красный) (это есть в макрорекодере) |
|
Отправлено: 15:25, 17-05-2016 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать a_axe,
Private Sub UserForm_Initialize() ComboBox1.List = Split("Черный,Красный,Зеленый,Желтый,Синий,Пурпурный,Циан,Белый", ",") 'заполняем выпадающее поле End Sub Private Sub CommandButton1_Click() Dim strFindWhat As String Dim strFirstFoundAddress As String Dim objRange As Range Dim intFoundPosition As Integer strFindWhat = Val(TextBox1.Text) 'забираем данные из текстового поля sFontColorAsk = ComboBox1.Text 'забираем данные из выпадающего поля If sFontColorAsk = "Черный" Then sFontcolor = vbBlack If sFontColorAsk = "Красный" Then sFontcolor = vbRed If sFontColorAsk = "Зеленый" Then sFontcolor = vbGreen If sFontColorAsk = "Желтый" Then sFontcolor = vbYellow If sFontColorAsk = "Синий" Then sFontcolor = vbBlue If sFontColorAsk = "Пурпурный" Then sFontcolor = vbMagenta If sFontColorAsk = "Циан" Then sFontcolor = vbCyan If sFontColorAsk = "Белый" Then sFontcolor = vbWhite With ActiveSheet.UsedRange Set objRange = .Find(What:=strFindWhat, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not objRange Is Nothing Then strFirstFoundAddress = objRange.Address Do intFoundPosition = InStr(1, objRange.Value, strFindWhat, vbTextCompare) Do While intFoundPosition > 0 objRange.Characters(intFoundPosition, Len(strFindWhat)).Font.color = sFontcolor intFoundPosition = InStr(intFoundPosition + 1, objRange.Value, strFindWhat, vbTextCompare) Loop Set objRange = .FindNext(After:=objRange) Loop Until objRange.Address = strFirstFoundAddress End If End With End Sub Так же через Case? |
Последний раз редактировалось blackeangel, 20-05-2016 в 15:27. Отправлено: 15:11, 20-05-2016 | #11 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать a_axe, если интересно, то вот идея Ваша реализованная в UserForm. Получилось красиво)
|
------- Последний раз редактировалось blackeangel, 03-04-2017 в 22:53. Отправлено: 22:23, 22-05-2016 | #12 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Некрасиво.
1. Проверяйте возвращаемое значение методом .Show() и обрабатывайте только True: 2. Метод «.Dialogs(xlDialogEditColor).Show(40, …)» не просто показывает диалог выбора цвета для указанного индекса палитры Рабочей книги, но и действительно меняет его. Это есть совсем нехорошо. Посему недостаточно просто использовать данный метод и забыть про последствия. Необходимо предварительно сохранить текущий цвет из указанного индекса палитры, использовать метод, получить выбранный цвет, вернуть сохранённый цвет индексу палитры. Наподобие: Option Explicit Dim lngSelectedColor As Long 'переменная уровня модуля для использования её внутри формы Private Sub btnGetColor_Click() Const intColorIndex = 40 Dim lngPrevColor As Long lngPrevColor = ThisWorkbook.Colors(intColorIndex) If Application.Dialogs(xlDialogEditColor).Show(intColorIndex, 255, 0, 0) Then lngSelectedColor = ThisWorkbook.Colors(intColorIndex) 'получаем выбранный код цвета btnGetColor.BackColor = intResult 'назначаем цвет специально выделенной кнопке ThisWorkbook.Colors(intColorIndex) = lngPrevColor End If End Sub |
Отправлено: 00:26, 23-05-2016 | #13 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Цитата Iska:
Цитата Iska:
Цитата Iska:
это одно и тоже. то есть вы противоречите Цитата Iska:
Цитата Iska:
|
|||||
------- Отправлено: 22:15, 23-05-2016 | #14 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата blackeangel:
Цитата blackeangel:
Цитата blackeangel:
Цитата blackeangel:
Цитата blackeangel:
Цитата blackeangel:
(и если б Вы добавили приведённое в коде требование «Option Explicit» — сразу бы сие увидели). Приношу Вам свои извинения за недоработку. |
||||||
Отправлено: 01:10, 24-05-2016 | #15 |
![]() |
Участник сейчас на форуме |
![]() |
Участник вне форума |
![]() |
Автор темы |
![]() |
Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
2010 - Поиск по листу и заполнение данными таблицы на другом листе | eus_deus | Microsoft Office (Word, Excel, Outlook и т.д.) | 1 | 25-03-2016 16:16 | |
CMD/BAT - скрипт на создание теста PerfMon по шаблону в ХР | saintman | Скриптовые языки администрирования Windows | 0 | 26-02-2014 16:28 | |
VBS/WSH/JS - [решено] замена текста в файле по шаблону | dembel_zone | Скриптовые языки администрирования Windows | 12 | 29-12-2013 19:21 | |
2003/XP/2000 - [решено] MS Word: добавление цвета в меню выделение текста цветом | AlexM | Microsoft Office (Word, Excel, Outlook и т.д.) | 4 | 05-03-2010 06:13 | |
[решено] Подчеркивание текста другим цветом | Kul86 | Вебмастеру | 2 | 27-05-2009 00:33 |
|