Вызов диалогового окна выбора цвета (Excel)

@Gepar · Регистрация: 01.07.2009

Студворк — интернет-сервис помощи студентам

Как вызвать диалоговое окно выбора цвета и как получить из него значение для закраски ячейки? Или оно и так возвращает 8 битное значение в границах 0-56? Я ведь, как оказалось, не могу покрасить ячейку вот так

Visual Basic
1
Cells.Interior.ColorIndex = число

цветом, код которого выходит за граници 0 - 56.

@ymnuhj · 06.04.2012, 23:28

Вот свойства кнопки, а тот сommom dialog не виден не в каком режиме

@Alex77755 · 07.04.2012, 03:20

Хм, действительно.

Что ж ты тогда видел.
Возможно в системе не зарегистрирован контрол сommondialog
Если бейсик установлен, то он его регистрирует, а кто его ещё устанавливает не знаю.
Можно самому скопировать и зарегистрировать comdlg32.ocx.
Потом кинуть его на лист

Добавлено через 24 минуты

Кроме того, в 64-битных Windows синтаксис вызова функций WinAPI тоже немного отличается от 32-битных систем.

В общем случае, код, корректно работающий в 64-битной Windows, будет выглядеть примерно так:

Visual Basic
1
2
3
4
5
#If Win64 Then
     Declare Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong
 #Else
     Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long
 #End If

Вот что нарыл пока.

Попробуй применить к коду Апострофа

Добавлено через 15 минут
Подробности здеся

Добавлено через 10 минут
Негде проверить. Можешь проверить и отписаться работает ли? У меня работает
дописать сообщение как в моём примере не составит труда. Просто хочу убедиться в соих догадках

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
 
#If Win64 Then
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As LongLong
#Else
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#End If
 
#If Win64 Then
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
 
 
#If Win64 Then
Private Type ChooseColor
  lStructSize As LongLong
  hwndOwner As LongLong
  hInstance As LongLong
  rgbResult As LongLong
  lpCustColors As String
  flags As LongLong
  lCustData As LongLong
  lpfnHook As LongLong
  lpTemplateName As String
End Type
 
#Else
Private Type ChooseColor
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  rgbResult As Long
  lpCustColors As String
  flags As Long
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
 
#End If
 
Private Function ShowColor() As Long 'код выбранного цвета
Dim CustomColors As Long
Dim ChooseColorStructure As ChooseColor
  Dim Custcolor(16) As Long
  Dim lReturn As Long
  ChooseColorStructure.lStructSize = Len(ChooseColorStructure)
  ChooseColorStructure.hwndOwner = FindWindow("XLMAIN", Application.Caption)
  ChooseColorStructure.hInstance = 0
  ChooseColorStructure.lpCustColors = StrConv(CustomColors, vbUnicode)
  ChooseColorStructure.flags = 0
  If ChooseColor(ChooseColorStructure) <> 0 Then
    ShowColor = ChooseColorStructure.rgbResult
    CustomColors = StrConv(ChooseColorStructure.lpCustColors, vbFromUnicode)
  Else
    ShowColor = -1
  End If
End Function
 
Sub ColorTime()
Selection.Interior.Color = ShowColor
End Sub

@Alex77755 · 07.04.2012, 03:46

Три в одном

@ymnuhj · 07.04.2012, 13:21

Попробовал последний файл выбор цвета. Результаты на снимках.

Может можно отказаться от Declatation? А то с ним одни проблемы. Кроме того даже если удастся настроить код на 64битную машину, нужно чтоб на 32битной он работать не перестал.

Мне кажется достаточно просто переделать функцию QWERT чтоб она возвращала RGB(R,G,B). Если она на это способна, то это будет идеально.

@Alex77755 · 07.04.2012, 13:33

Ну с Hex можно побороться написав VBA.Hex
На счёт декларирования надо ещё копать. Там есть ещё и комбинации 64+ексел2010.
У меня в 2010 работают все варианты.
На счет функции: тебе же надо именно выбрать цвет!? Так что надо показать палитру.
А это можно либо АПИ функцией.(но её надо правильно задекларировать. Посмотри по ссылке).
Либо установить и зарегить comdlg32.ocx.

Добавлено через 3 минуты
Если б это было в бейсике можно было бы подсунуть свою картинку с палитрой и считать цвет пикселя. А в VBA я не сталкивался как можно считать цвет пикселя. Наверняка есть АПИ функция.
Но опять же возникнет вопрос с декларацией

@ymnuhj · 07.04.2012, 13:34

Application.Dialogs(xlDialogPatterns).Sh ow показывает палитру. На 32бит разве не так?

@Alex77755 · 07.04.2012, 13:46

Действительно. В 2010 мало работал
В 2003 вызывал

Visual Basic
1
Application.CommandBars("Fill Color").Visible = True

Dragokas · 11.04.2012, 00:08

Если интересно, вот моя палитра для Office 2003 по ColorIndex-ам - 46 цветов (на 6 больше чем в стандартной на панеле форматирования).

@anton-sf · 25.05.2019, 19:32

Нашёл решение на https://excelvba.ru/code/PickNewColor и немного переделал,
именно то что нужно было автору (возврат цвета как результат функции). Но, видимо поздно

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    'Пример использования GetColorFromDialog
    '...
    Dim Color As Long
    '...
    Color = GetColorFromDialog(Control.ForeColor)
    'Так как используется диалог (который может быть отменен) то делаем проверку результата
    If Color <> xlNone Then
        Control.ForeColor = Color
    End If
    '...
 
Public Function GetColorFromDialog(Optional ByVal BaseColor As Long = xlNone) As Long
    Dim Result As Long
    Dim UsedWorkbook As Workbook
    Dim DefaultColor As Long
    Dim LastColorIndex As Integer
    Dim ColorR As Byte
    Dim ColorG As Byte
    Dim ColorB As Byte
    
    LastColorIndex = 32 'Правый нижний индекс цвета в окне 'Параметры\Цвет'
    
    'В диалоговое окно изменения цвета можно отправить некий базовый цвет,
    'чтобы его значения автоматом проставились в элементах вкладки 'Спектр'
    'Если цвет передан в эту функцию то разложим его на RGB,
    'если нет то в диалог уйдёт чёрный цвет
    If BaseColor <> xlNone Then
        ColorR = BaseColor And &HFF
        ColorG = Int(BaseColor / &H100) And &HFF
        ColorB = Int(BaseColor / &H10000) And &HFF
    End If
    
    If ActiveWorkbook Is Nothing Then
        Set UsedWorkbook = Workbooks.Add 'Если Excel запущен но не содержит ни одной книги то создадим книгу
    Else
        Set UsedWorkbook = ActiveWorkbook
    End If
    
    DefaultColor = UsedWorkbook.Colors(LastColorIndex) 'Запомним значение цвета по молчанию
    
    If Application.Dialogs(xlDialogEditColor).Show(LastColorIndex, ColorR, ColorG, ColorB) Then
        Result = UsedWorkbook.Colors(LastColorIndex) 'Запомним новое значение цвета - это наш результат
    Else
        Result = xlNone 'Если диалог отменен то вернем xlNone как результат функции
    End If
    
    UsedWorkbook.Colors(LastColorIndex) = DefaultColor 'Вернем используемой книге значение цвета по молчанию
    
    'Если используемая книга создана этой функцией то, по-идее, её надо бы закрыть,
    'но здесь этого не сделано так как мне неизвестно что будет если Excel останется без открытых книг
    
    GetColorFromDialog = Result
End Function

Новые блоги и статьи Все статьи Все блоги /
FPS контроллер с анимированными Y-Bot и 3D-звуком miniaudio (Box3D, Recast, BehaviorTree.CPP, ozz-animation, ImGui, OpenGL и SDL3) 8Observer8 18.10.2026 Содержание блога \| English Version Полное мультиплатформенное руководство по стартовому проекту с FPS-контроллером игрока, анимированными роботами Y-Bot с 4-слойным блендингом, 3D-физикой Box3D,. . .	Локальный http сервер Argus19 17.10.2026 Локальный http сервер На работе, на двух локальных компьютерах круглосуточно работают программы опроса приборов с записью в книги Excel,которые раз в сутки записываются на сервер компании. Т. к. . . .	Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .
Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .

@ymnuhj 2 / 2 / 0 Регистрация: 26.03.2012 Сообщений: 33
	06.04.2012, 23:28
	Вот свойства кнопки, а тот сommom dialog не виден не в каком режиме Миниатюры 0

@ymnuhj 2 / 2 / 0 Регистрация: 26.03.2012 Сообщений: 33
	07.04.2012, 13:21
	Попробовал последний файл выбор цвета. Результаты на снимках. Может можно отказаться от Declatation? А то с ним одни проблемы. Кроме того даже если удастся настроить код на 64битную машину, нужно чтоб на 32битной он работать не перестал. Мне кажется достаточно просто переделать функцию QWERT чтоб она возвращала RGB(R,G,B). Если она на это способна, то это будет идеально. Миниатюры 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	07.04.2012, 13:33
	Ну с Hex можно побороться написав VBA.Hex На счёт декларирования надо ещё копать. Там есть ещё и комбинации 64+ексел2010. У меня в 2010 работают все варианты. На счет функции: тебе же надо именно выбрать цвет!? Так что надо показать палитру. А это можно либо АПИ функцией.(но её надо правильно задекларировать. Посмотри по ссылке). Либо установить и зарегить comdlg32.ocx. Добавлено через 3 минуты Если б это было в бейсике можно было бы подсунуть свою картинку с палитрой и считать цвет пикселя. А в VBA я не сталкивался как можно считать цвет пикселя. Наверняка есть АПИ функция. Но опять же возникнет вопрос с декларацией 0

@ymnuhj 2 / 2 / 0 Регистрация: 26.03.2012 Сообщений: 33
	07.04.2012, 13:34
	Application.Dialogs(xlDialogPatterns).Sh ow показывает палитру. На 32бит разве не так? 1