Можно ли средствами VBA переименовать цвет в палитре?

[saygak]

Создал палитру на 2000 цветов, как бы им названия присвоить? Только вручную в Palette Editor?

 

[Asmussen]

Ответ: Можно ли средствами VBA переименовать цвет в палитре?

Конечно возможно. В активной палитре , например, изменить имя первого цвета можно так - ActivePalette.Colors(1).SetName "Имя". Единственный вопрос, откуда 2000 имен брать?

 

[saygak]

Ответ: Можно ли средствами VBA переименовать цвет в палитре?

Спасибо, попробую. Имена собираюсь брать из двух тысяч Artistic Text, размещенных по порядку.

 

[saygak]

Ответ: Можно ли средствами VBA переименовать цвет в палитре?

Вначале написал такой макрос:

Sub AddColor()
Dim pal As Palette
    Set pal = ActivePalette
Dim c As New Color
Dim R, G, B As Long
Dim Koler As String
Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange

Dim Co, n As Long
    Co = OrigSelection.Shapes.Count
    
For n = 1 To Co Step 4

OrigSelection(n).CreateSelection
R = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
G = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
B = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
Koler = CorelScript.GetTextString

    
c.RGBAssign R, G, B
pal.AddColor c
n = n / 4
ActivePalette.Colors(n).SetName Koler
n = n * 4 - 3
Next n
pal.Save

End Sub

При его выполнении выскочило такое сообщение:
Color Index is out of range, its value must be between 1 and 382

Что это за странное ограничение? При том что палитры бывают и больше 382 цветов.

Решил проблему своеобразно, при помощи GetIndexOfColor

Sub AddColor()
Dim pal As Palette
    Set pal = ActivePalette
Dim c As New Color
Dim d As New Color
Dim R, G, B As Long
Dim Koler As String
Dim idx As Long
Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange

Dim Co, n As Long
    Co = OrigSelection.Shapes.Count
    
For n = 1 To Co Step 4

OrigSelection(n).CreateSelection
R = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
G = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
B = CorelScript.GetTextString
n = n + 1
OrigSelection(n).CreateSelection
Koler = CorelScript.GetTextString

    
c.RGBAssign R, G, B
pal.AddColor c
pal.Save
d.RGBAssign R, G, B
idx = ActivePalette.GetIndexOfColor(d)
ActivePalette.Colors(idx).SetName Koler
n = n - 3
Next n
pal.Save

End Sub

Все обработал за милую душу, все две тысячи цветов.
Однако, прикольно.