Диалоговое окно выбора цвета (функция VBA для запроса цвета заливки)

Настройки цвета заливки на форме VBA

Данная функция позволяет запрашивать у пользователя цвет заливки.

Функция возвращает целое число - значение цвета в формате RGB

Пример использования:

Sub ОкраскаЯчейкиВВыбранныйЦвет()
    On Error Resume Next
    DefaultColor& = vbRed    ' цвет по-умолчанию
    NewColor& = PickNewColor(DefaultColor&)    ' выбираем новый цвет
    
    ActiveCell.Interior.Color = NewColor&    ' красим активную ячейку
End Sub

Код функции:

Function PickNewColor(Optional ByVal i_OldColor As Double = xlNone) As Double
    ' функция отображает диалоговое окно выбора цвета заливки
    ' и возвращает значение выбранного цвета
    On Error Resume Next:
    PickNewColor = i_OldColor
    Const BGColor As Long = 13160660, ColorIndexLast As Long = 32
    Dim myOrgColor As Double, myNewColor As Double, WB As Workbook
    Dim myRGB_R As Integer, myRGB_G As Integer, myRGB_B As Integer
    If ActiveWorkbook Is Nothing Then Application.ScreenUpdating = False: Set WB = Workbooks.Add
    myOrgColor = ActiveWorkbook.Colors(ColorIndexLast)    'save original palette color

    i_Color = IIf(i_OldColor = xlNone, BGColor, i_OldColor): myRGB_R = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_G = i_Color Mod 256
    i_Color = i_Color \ 256: myRGB_B = i_Color Mod 256
    ActiveWorkbook.ResetColors    'AppActivate Application.Name
    If Application.Dialogs(xlDialogEditColor).Show(ColorIndexLast, myRGB_R, myRGB_G, myRGB_B) Then
        PickNewColor = ActiveWorkbook.Colors(ColorIndexLast)
        ThisWorkbook.Colors(ColorIndexLast) = myOrgColor
    End If
    If Not WB Is Nothing Then WB.Close False: Application.ScreenUpdating = True
End Function

В прикреплённом файле, - пример использования функции для выбора цветов на форме

ВложениеРазмерЗагрузкиПоследняя загрузка
PickColor_Userform.xls47 КБ114 года 36 недель назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

как ввести макрос дата-цвет в ехел 2010

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _       _   _  _                           
| | (_) | || | _ _ __ _ _ __
| | | | | || |_ | | | | / _` | | '_ \
| |___ | | |__ _| | |_| | | (_| | | |_) |
|_____| |_| |_| \__,_| \__, | | .__/
|_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.