Цитата blackeangel:
|
Если есть вариант проще, то это интересно. »
|
blackeangel, к программной реализации вопросов особенных нет, а вот взаимодействие с программой на мой взгляд можно построить следующим образом (я излагаю свое представление об удобстве, разумеется у вас оно может полностью не совпадать)
1. каждый раз вводить
полное наименование цвета на мой взгляд неудобно. По хорошему можно
сделать форму (одну - с текстовым окном и опциями выбора цвета), в которую вы сразу будете забивать свой поисковый шаблон и при необходимости - выбирать мышкой цвет.
При вводе через input я бы ограничился вводом первой буквы: не "красный", а просто "к". Кроме того, при наличии орфографической неточности (например "краный", или "Чёрный" вместо "Черный") соответствия найдено не будет, вполне можно принудительно присвоить в этом случае цвет (например черный) и предупредить об этом пользователя. Реализовать все вышеперечисленное можно через select case:
код Select case
Код:
Select Case LCase(sFontColorAsk)
Case "к"
sFontColor = vbRed
Case "з"
sFontColor = vbGreen
Case "ж"
sFontColor = vbYellow
Case "с"
sFontColor = vbBlue
Case "п"
sFontColor = vbMagenta
Case "ц"
sFontColor = vbCyan
Case "б"
sFontColor = vbWhite
Case "ч"
sFontColor = vbBlack
Case Else
sFontColor = vbBlack
MsgBox "Цвет не распознан, применен черный"
End Select
2. Введенный цвет следует не проверять в обоих регистрах (If sFontColorAsk = "черный" Or sFontColorAsk = "Черный"), а перевести в заданный(например нижний) регистр:
LCase(sFontColorAsk). Это ускорит работу кода.
3.при вводе цвета текста нужно вставить значение по умолчанию, чтобы сократить количество ненужных действий (например красный):
код
Код:
sFontColorAsk = InputBox("Введите один из цветов: " _
& Chr(13) & "черный (ч), красный (к),зеленый (з)," _
& Chr(13) & "желтый (ж), синий (с), пурпурный (п), циан (ц), белый (б)", , "к")
Соответственно, код будет выглядеть следующим образом:
код
Код:
Sub colorr2()
Dim strFindWhat As String
Dim strFirstFoundAddress As String
Dim objRange As Range
Dim intFoundPosition As Integer
strFindWhat = InputBox("Введите что подкрасить")
sFontColorAsk = InputBox("Введите один из цветов: " _
& Chr(13) & "черный (ч), красный (к),зеленый (з)," _
& Chr(13) & "желтый (ж), синий (с), пурпурный (п), циан (ц), белый (б)", , "к")
Select Case LCase(sFontColorAsk)
Case "к"
sFontColor = vbRed
Case "з"
sFontColor = vbGreen
Case "ж"
sFontColor = vbYellow
Case "с"
sFontColor = vbBlue
Case "п"
sFontColor = vbMagenta
Case "ц"
sFontColor = vbCyan
Case "б"
sFontColor = vbWhite
Case "ч"
sFontColor = vbBlack
Case Else
sFontColor = vbBlack
MsgBox "Цвет не распознан, применен черный"
End Select
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
.
