Преобразовать из .Interior.ColorIndex в имя цвета - VBA - PullRequest
0 голосов
/ 25 июня 2019

Есть ли способ преобразовать .Interior.ColorIndex в имя цвета с помощью VBA? Ниже приведены только получить индекс цвета. Мне не удается найти способ преобразовать его в название цвета.

Код:

Option Explicit

Sub test()

    Dim Color As Variant

    With ThisWorkbook.Worksheets("Sheet1").Range("A1")
        Color = .Interior.ColorIndex
    End With

End Sub

1 Ответ

1 голос
/ 25 июня 2019

Это общий запрос для VBA. На других языках это действие «получить имя для перечисления» обеспечивается службой, называемой отражением. К сожалению, VBA не обеспечивает отражения «из коробки», так как во многих вещах в VBA нам нужно настроить шаблонный класс, чтобы сделать работу за нас. Вставьте приведенный ниже код в VBA как класс с именем 'ColoursEnum'

Этот класс также является примером класса с одним экземпляром, в котором мы намеренно переопределяем стандарт VBA по умолчанию и разрешаем для нас объявить один экземпляр класса (т. Е. Нам не нужно делать 'New ColoursEnum'

Это перечисление обеспечивает надежную обработку итерации перечисления. При обычном перечислении VBA вы можете столкнуться с проблемами несуществующих перечислителей, если диапазон длинных значений не является непрерывным. Для ColoursEnum мы получаем элементы как массив вариантов и, следовательно, можем перебирать массив, не беспокоясь о том, что они не являются непрерывным диапазоном.

Этот класс также расширяет концепцию «Exists» в Scripting.dictionary, позволяя текстам присутствовать или отсутствовать ключ или значение. Отсутствие необходимости ставить знак NOT перед Exists делает код более читабельным (например, «LacksKey (ключ)» вместо «Not Exists (ключ)»

Составляя этот ответ, я глубоко признателен за прекрасные статьи VBA о проблемах, написанные командой RubberDuck.

Несмотря на то, что класс создан для нас по умолчанию, нам все равно нужно инициализировать используемые им словари, поэтому мы должны сделать

ColoursEnum.Setup

перед использованием словаря.

Кроме того, поскольку у нас есть класс, а не модуль, мы можем установить ссылку

set my_colours = ColoursEnum
.....
if my_colours.LacksItem("Red") then etc....

=============================================== ===========

'@PredeclaredId
'@Exposed
Option Explicit
' This code requres that references are available for
' Microsoft Word
' Microsoft Scripting runtime

' An example of a class to provide reflection of a colour enumeration
' The enumeration in this class allows extension for user defined colours
' The class must be exported, the predeclaredId set to true and then reimported
' Instances of this class are not allowed
' This example is based on the wdColor enumeration

Public Enum Colours

' We wish to use custom colours so to prevent clashes with the wdcolor enumeration
' we assign our own names

    Aqua = wdColorAqua                                                     '13421619    0x00CCCC33
    Automatic = wdColorAutomatic                                           '-16777216   0xFF000000
    Black = wdColorBlack                                                   '0           0x00000000
    Blue = wdColorBlue                                                     '16711680    0x00FF0000
    BlueGray = wdColorBlueGray                                             '10053222
    BrightGreen = wdColorBrightGreen                                       '65280       0x0000FF00
    Brown = wdColorBrown                                                   '13209
    DarkBlue = wdColorDarkBlue                                             '8388608
    DarkGreen = wdColorDarkGreen                                           '13056
    DarkRed = wdColorDarkRed                                               '128         0x00000080
    DarkTeal = wdColorDarkTeal                                             '6697728
    DarkYellow = wdColorDarkYellow                                         '32896
    Gold = wdColorGold                                                     '52479
    Gray05 = wdColorGray05                                                 '15987699
    Gray10 = wdColorGray10                                                 '15132390
    Gray125 = wdColorGray125                                               '14737632
    Gray15 = wdColorGray15                                                 '14277081
    Gray20 = wdColorGray20                                                 '13421772
    Gray25 = wdColorGray25                                                 '12632256
    Gray30 = wdColorGray30                                                 '11776947
    Gray35 = wdColorGray35                                                 '10921638
    Gray375 = wdColorGray375                                               '10526880
    Gray40 = wdColorGray40                                                 '10066329
    Gray45 = wdColorGray45                                                 '9211020
    Gray50 = wdColorGray50                                                 '8421504
    Gray55 = wdColorGray55                                                 '7566195
    Gray60 = wdColorGray60                                                 '6710886
    Gray625 = wdColorGray625                                               '6316128
    Gray65 = wdColorGray65                                                 '5855577
    Gray70 = wdColorGray70                                                 '5000268
    Gray75 = wdColorGray75                                                 '4210752
    Gray80 = wdColorGray80                                                 '3355443
    Gray85 = wdColorGray85                                                 '2500134
    Gray875 = wdColorGray875                                               '2105376
    Gray90 = wdColorGray90                                                 '1644825
    Gray95 = wdColorGray95                                                 '789516
    Green = wdColorGreen                                                   '32768
    Indigo = wdColorIndigo                                                 '10040115
    Lavender = wdColorLavender                                             '16751052
    LightBlue = wdColorLightBlue                                           '16737843
    LightGreen = wdColorLightGreen                                         '13434828
    LightOrange = wdColorLightOrange                                       '39423
    LightTurquoise = wdColorLightTurquoise                                 '16777164
    LightYellow = wdColorLightYellow                                       '10092543
    Lime = wdColorLime                                                     '52377
    OliveGreen = wdColorOliveGreen                                         '13107
    Orange = wdColorOrange                                                 '26367
    PaleBlue = wdColorPaleBlue                                             '16764057
    Pink = wdColorPink                                                     '16711935
    Plum = wdColorPlum                                                     '6697881
    Red = wdColorRed                                                       '255         0x000000FF
    Rose = wdColorRose                                                     '13408767
    SeaGree = wdColorSeaGreen                                              '6723891
    SkyBlue = wdColorSkyBlue                                               '16763904
    Tan = wdColorTan                                                       '10079487
    Teal = wdColorTeal                                                     '8421376
    Turquoise = wdColorTurquoise                                           '16776960
    Violet = wdColorViolet                                                 '8388736
    White = wdColorWhite                                                   '16777215    0x00FFFFFF
    Yellow = wdColorYellow                                                 '65535
    ' Add custom s from this point onwards
    HeadingBlue = &H993300                                                 'RGB(0,51,153)   0x00993300
    HeadingGreen = &H92D050                                                'RGB(146,208,80) 0x0050D092

End Enum

Private Type Properties
' See https://rubberduckvba.wordpress.com/2018/04/25/private-this-as-tsomething/

    enum_gets_value                             As Scripting.Dictionary
    value_gets_enum                             As Scripting.Dictionary

End Type


Private Type State

    Initialised                                 As Boolean

End Type

Private s                                       As State
Private p                                       As Properties


Private Sub Class_Initialize()
' Generate an error for the use of New ColoursEnum

    If s.Initialised Then
        Err.Raise 360, TypeName(Me), "This class does not permit instances other than the PredeclaredId"
        Stop
    Else
        s.Initialised = True
    End If

End Sub



Public Sub Setup()

    Set p.enum_gets_value = New Scripting.Dictionary
    Set p.value_gets_enum = New Scripting.Dictionary

    With p.enum_gets_value

        .Add Key:=Aqua, Item:="Aqua"
        .Add Key:=Automatic, Item:="Automatic"
        .Add Key:=Black, Item:="Black"
        .Add Key:=Blue, Item:="Blue"
        .Add Key:=BlueGray, Item:="BlueGray"
        .Add Key:=BrightGreen, Item:="BrightGreen"
        .Add Key:=Brown, Item:="Brown"
        .Add Key:=DarkBlue, Item:="DarkBlue"
        .Add Key:=DarkGreen, Item:="DarkGreen"
        .Add Key:=DarkRed, Item:="DarkRed"
        .Add Key:=DarkTeal, Item:="DarkTeal"
        .Add Key:=DarkYellow, Item:="DarkYellow"
        .Add Key:=Gold, Item:="Gold"
        .Add Key:=Gray05, Item:="Gray05"
        .Add Key:=Gray10, Item:="Gray10"
        .Add Key:=Gray125, Item:="Gray125"
        .Add Key:=Gray15, Item:="Gray15"
        .Add Key:=Gray20, Item:="Gray20"
        .Add Key:=Gray25, Item:="Gray25"
        .Add Key:=Gray30, Item:="Gray30"
        .Add Key:=Gray35, Item:="Gray35"
        .Add Key:=Gray375, Item:="Gray375"
        .Add Key:=Gray40, Item:="Gray40"
        .Add Key:=Gray45, Item:="Gray45"
        .Add Key:=Gray50, Item:="Gray50"
        .Add Key:=Gray55, Item:="Gray55"
        .Add Key:=Gray60, Item:="Gray60"
        .Add Key:=Gray625, Item:="Gray625"
        .Add Key:=Gray65, Item:="Gray65"
        .Add Key:=Gray70, Item:="Gray70"
        .Add Key:=Gray75, Item:="Gray75"
        .Add Key:=Gray80, Item:="Gray80"
        .Add Key:=Gray85, Item:="Gray85"
        .Add Key:=Gray875, Item:="Gray875"
        .Add Key:=Gray90, Item:="Gray90"
        .Add Key:=Gray95, Item:="Gray95"
        .Add Key:=Green, Item:="Green"
        .Add Key:=Indigo, Item:="Indigo"
        .Add Key:=Lavender, Item:="Lavender"
        .Add Key:=LightBlue, Item:="LightBlue"
        .Add Key:=LightGreen, Item:="LightGreen"
        .Add Key:=LightOrange, Item:="LightOrange"
        .Add Key:=LightTurquoise, Item:="LightTurquoise"
        .Add Key:=LightYellow, Item:="LightYellow"
        .Add Key:=Lime, Item:="Lime"
        .Add Key:=OliveGreen, Item:="OliveGreen"
        .Add Key:=Orange, Item:="Orange"
        .Add Key:=PaleBlue, Item:="PaleBlue"
        .Add Key:=Pink, Item:="Pink"
        .Add Key:=Plum, Item:="Plum"
        .Add Key:=Red, Item:="Red"
        .Add Key:=Rose, Item:="Rose"
        .Add Key:=SeaGree, Item:="SeaGreen"
        .Add Key:=SkyBlue, Item:="SkyBlue"
        .Add Key:=Tan, Item:="Tan"
        .Add Key:=Teal, Item:="Teal"
        .Add Key:=Turquoise, Item:="Turquoise"
        .Add Key:=Violet, Item:="Violet"
        .Add Key:=White, Item:="White"
        .Add Key:=Yellow, Item:="Yellow"
        .Add Key:=HeadingBlue, Item:="HeadingBlue"
        .Add Key:=HeadingGreen, Item:="HeadingGreen"

    End With

    Dim my_keys()                   As Variant
    Dim my_key                      As Variant

    my_keys = p.enum_gets_value.Keys

    For Each my_key In my_keys


    ' For a reflected enumeration we are guaranteed that all values are unique
    ' so we don't need error checking when reversing the dictionary

        p.value_gets_enum.Add p.enum_gets_value.Item(my_key), my_key

    Next

End Sub


Public Property Get Items() As Variant
    Set Items = p.enum_gets_value.Items
End Property

Public Property Get Enums() As Variant
    Set Enums = p.enum_gets_value.Keys
End Property

Public Property Get Item(ByVal this_enum As Colours) As String
    Item = p.enum_gets_value.Item(this_enum)
End Property

' VBA will not allow a property named 'Enum' so we use
' ü (alt+0252) to sidestep the keyword clash for this property Item
' I don't like this hack
Public Property Get Enüm(ByVal this_item As String) As Colours
    Enüm = p.value_gets_enum.Item(this_item)
End Property

Public Function HoldsEnum(ByVal this_enum As Colours) As Boolean
    HoldsEnum = p.enum_gets_value.Exists(this_enum)
End Function

Public Function LacksEnum(ByVal this_enum As Colours) As Boolean
    LacksEnum = Not Me.HoldsEnum(this_enum)
End Function

Public Function HoldsItem(ByVal this_item As String) As Boolean
    HoldsItem = p.value_gets_enum.Exists(this_item)
End Function

Public Function LacksItem(ByVal this_item As String) As Boolean
    LacksItem = Not Me.HoldsItem(this_item)
End Function

Public Function Count() As Long
    Count = p.enum_gets_value.Count
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...