Вызов диалогового окна выбора цвета (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

Новые блоги и статьи Все статьи Все блоги /
FSharp: interface of module DevAlt 16.05.2026 Интерфейс модуля F# позволяет управлять доступностью членов, содержащихся в реализации модуля. По-умолчанию все члены модуля доступны: module Foo let x = 10 let boo () = printfn "boo" . . .	Хитросплетение родственных связей пантеона греческих богов. russiannick 14.05.2026 Однооконник, позволяющий узреть и изучить отдельных героев древней Греции. <!DOCTYPE html> <html lang="ru"> <head> <meta charset="UTF-8"> <meta http-equiv="X-UA-Compatible". . .	[golang] Угол между стрелками часов alhaos 12.05.2026 По заданным значениям часа и минуты необходимо определить значение меньшего угла между стрелками аналогового циферблата часов. import "math" func angleClock(hour int, minutes int) float64 { . . .	Debian 13: Установка Lazarus QT5 ВитГо 09.05.2026 Эта инструкция моя компиляция инструкций volvo https:/ / www. cyberforum. ru/ blogs/ 203668/ 10753. html и его же старой инструкции по установке Lazarus с gtk2. . .
Нейросеть на алгоритме "эстафета хвоста" как перспектива. Hrethgir 06.05.2026 На десерт, когда запущу сервер. Статья тут https:/ / habr. com/ ru/ articles/ 1030914/ . Автор я сам, нейросеть только помогает в вопросах которые мне не известны - не знаю людей которые знали-бы. . .	Асинхронный приём данных из COM-порта Argus19 01.05.2026 Асинхронный приём данных из COM-порта Купил на aliexpress термопринтер QR701. Он оказался странным. Поключил к Arduino Nano. Был очень удивлён. Наотрез отказывается печатать русские буквы. Чтобы. . .	попытка написать игровой сервер на C++ pyirrlicht 29.04.2026 попытка написать игровой сервер на плюсах с открытым бесконечным миром. возможно получится прикрутить интерпретатор питон для кастомизации игровой логики. что есть на текущий момент:. . .	Контроль уникальности выбранного документа-основания при изменении реквизита Maks 28.04.2026 Алгоритм из решения ниже разработан на примере нетипового документа "ЗаявкаНаРемонтСпецтехники", разработанного в КА2. Задача: уведомлять пользователя, если указанная заявка (документ-основание). . .

@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