Выбор цвета

[Fiesta200]

У меня есть простенький макрос, который упрощает мне работу с таблицами (не надо кучу раз лазить в меню). Задача его такова: на выделенную ячейку таблицы макрос сначала делает цвет для текста (зеленый, скажем), потом еще раз вызывается меню «Границы и заливки» и тот же цвет задается абзацу.

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

Каким образом может макрос задать пользователю вопрос, какой цвет применить? То есть, надо, чтобы вызывалась на экран менюха Границы (с выставленными всеми параметрами), где надо указать цвет (первый раз — для текста, для абзаца — цвет тот же автоматич. должен быть применен). Это может быть просто окно Палитры цветов.

Такая прибамбасина точно есть в Фотошопе (Спросить параметр у пользователя). Есть что-либо подобное в VB?

[Fiesta200]

Вот что хочется получить (такое окошко с палитрой): http://www.functionx.com/vbnet/controls/colordialog.htm
Но как именно внедрить в макрос — я не знаю. У меня постоянно выбивает ошибку.

[viter.alex]

Держи готовый код.

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type

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


Dim CustomColors() As Byte
Dim CursorPos As POINTAPI

Function SelectColor() As Long
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long
    Dim i As Integer
    
    ReDim CustomColors(0 To 16 * 4 - 1) As Byte
    
    For i = LBound(CustomColors) To UBound(CustomColors)
        CustomColors(i) = 0
    Next i
    GetCursorPos CursorPos
    With cc
      .lStructSize = Len(cc)
      .hwndOwner = WindowFromPoint(CursorPos.x, CursorPos.y)
      .hInstance = 0
      .lpCustColors = StrConv(CustomColors, vbUnicode)
      .flags = 0
    End With
    
    lReturn = ChooseColorAPI(cc)
    
    If lReturn <> 0 Then
        SelectColor = cc.rgbResult
    Else
        SelectColor = -1
    End If
End Function

Функция SelectColor. Возвращает номер цвета, выбранный в диалоге. Если нажали "Отмена", то вернёт -1.
Взято отсюда и немного изменено.
Дополнительные параметры диалога: цвет по умолчанию, пользовательские цвета, развёрнутый или свёрнутый и т.д. находятся здесь

[Fiesta200]

Спасибо, viter.alex.
Отдельно - работает на ура. А в макросе - нет.
Наверное, я крыво что-то вставляю.
Этот выбранный цвет должен быть как значение для BackgroundPatternColor.

Речь идет о:

PHP код:

Sub Table_color_cell()
'Makros
    With Selection.ParagraphFormat.Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = wdColorTurquoise
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    With Selection.Cells
        With .Shading
            .Texture = wdTextureNone
            .ForegroundPatternColor = wdColorAutomatic
            .BackgroundPatternColor = wdColorTurquoise
        End With
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth050pt
        .DefaultBorderColor = wdColorAutomatic
    End With
End Function 


[viter.alex]

Сообщение от Fiesta200

…Этот выбранный цвет должен быть как значение для BackgroundPatternColor…

Читаем справку:

Returns or sets the 24-bit color that's applied to the background of the Shading object. Read/write.
Syntax

expression.BackgroundPatternColor

expression Required. A variable that represents a Shading object.

Remarks


This property can be any valid WdColor constant or a value returned by Visual Basic's RGB function.

Т.е. всё правильно. Моя функция тоже возвращает число, как и RGB. Пробую ещё раз у себя:

Sub test()
  Dim nColor As Long
  nColor = SelectColor
  If nColor >= 0 Then
    Selection.Shading.BackgroundPatternColor = nColor
  End If
End Sub

Всё работает

[Fiesta200]

Что-то у меня долго не получалось, но в конце концов заработал макрос.
Искреннее признательное спасибо!!!!



А вот такой вопрос в плане улучшения существующего: можна, чтобы выбор цвета на вкладке производился двойным щелчком мышки по ячейке (не нажимая Ок)? Возможно, это невозможно посредством макроса, так как алгоритм работы КаларДиалог не зависит от желаний VB?..

[viter.alex]

Строго говоря, у структуры CHOOSECOLOR есть параметр lpfnHook, в котором можно указать адрес процедуры, обрабатывающей сообщения диалога. Но я не нашёл примера использования: какое сообщение нужно перехватывать для определения выбранного цвета.

[Fiesta200]

Тогда остановимся на достигнутом

Тему можна закрывать.

[Aent]

http://win-api.narod.ru/a0570.htm
Главное - не ошибиться с ручкой щётки и рычажной процедурой