Вызов палитры из UserForm и присвоение константе выбранного цвета - VBA

Узнай цену своей работы

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

Доброго времени суток. Собственно задача и есть созданная тема. Вопрос лишь в том как это реализовать. Для чего присваивать переменной/константе значение? Для дальнейшего окрашивания текста. Значение должно быть в системе RGB(0,0,0), т.к. Font.Сolor потребляет его.

Решение задачи: «Вызов палитры из UserForm и присвоение константе выбранного цвета»

textual
Листинг программы
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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

13   голосов , оценка 4.385 из 5
Похожие ответы