VBA Tipp: Farbauswahl-Dialog

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Windows-Farbauswahl-Dialog aufrufen.

Lösung:

Das geht mit der folgenden API-Deklaration und Funktion, die in einem globalen Modul hinterlegt werden:

Private Type CHOOSECOLOR
     lStructSize    As Long
     hwndOwner      As Long
     hInstance      As Long
     rgbResult      As Long
     lpCustColors   As Long
     Flags          As Long
     lCustData      As Long
     lpfnHook       As Long
     lpTemplateName As String
End Type
 
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
 
Private Declare Function APIChooseColor Lib "comdlg32.dll" _
                 Alias "ChooseColorA" (LPCHOOSECOLOR As CHOOSECOLOR) As Long
 
Public Function Farbauswahl(Optional Vorgabewert As Long = 0, _
                            Optional ByVal ErweiterteAnsicht As Boolean = False _
                            ) As Long
 
 'Quelle: http://www.dbwiki.net/
 
 Dim CC As CHOOSECOLOR
 Static alCustcolors(15) As Long
 Dim hWnd As Long
 Dim lngret As Long
 
 'Flag-Konstanten
 Const CC_RGBINIT = &H1               'Vorgabe einer Standard-Farbe möglich
 Const CC_FULLOPEN = &H2              'Erweiterte Menü-Ansicht anzeigen
 Const CC_PREVENTFULLOPEN = &H4       'Schaltfläche "Farben definieren >>" deaktivieren
 Const CC_SHOWHELP = &H8              'Hilfe-Schaltfläche anzeigen
 Const CC_ENABLEHOOK = &H10           'Nachrichten können "abgefangen" werden
 Const CC_ENABLETEMPLATE = &H20       'Dialogbox Template
 Const CC_ENABLETEMPLATEHANDLE = &H40 'Benutzt Template, ignoriert aber den Template-Namen
 Const CC_SOLIDCOLOR = &H80           'nur Grundfarben auswählbar
 Const CC_ANYCOLOR = &H100            'erlaubt auch die Auswahl von Nicht-VGA-Farben
 
 'Fenster-Handle auslesen
 hWnd = GetActiveWindow()
 
 CC.lStructSize = Len(CC) 'Strukturgröße
 CC.hInstance = 0         'Anwendungs-Instanz
 CC.hwndOwner = hWnd      'Aufrufendes Fenster-Handle
 
 'Benutzerdefinierte Farben zuweisen
 CC.lpCustColors = VarPtr(alCustcolors(0))
 
 'Flags
 CC.Flags = CC_RGBINIT Or CC_ANYCOLOR
 If ErweiterteAnsicht = True Then
   CC.Flags = CC.Flags Or CC_FULLOPEN
 End If
 
 'Vorgabewert setzen
 CC.rgbResult = Vorgabewert
 
 'Rückgabewert
 lngret = APIChooseColor(CC)
 
 'Wenn Abbrechen gedrückt wurde, -1 zurückgeben (lngret = 0)
 If lngret = 0 Then
   Farbauswahl = -1
 'Wenn OK gedrückt wurde, gewählten Farbwert zurückgeben (lngret = 1)
 Else
   Farbauswahl = CC.rgbResult
 End If
 
End Function

Aufruf

 'Möglichkeit 1: Farbauswahl-Dialog aufrufen
 MsgBox Farbauswahl
 
 
 'Möglichkeit 2: Farbauswahl-Dialog mit Vorgabewert aufrufen
 MsgBox Farbauswahl(vbMagenta)
 'oder
 MsgBox Farbauswahl(16711935)
 
 
 'Möglichkeit 3: Farbauswahl-Dialog in erweiterter Ansicht aufrufen
 MsgBox Farbauswahl(, True)
 
 
 'Möglichkeit 4: Falls gewünscht, kann das Drücken der Schaltfläche "Abbrechen" ausgewertet werden.
 'Wenn Abbrechen gedrückt wurde, ist der Rückgabewert der Funktion -1.
 Dim lngrück As Long
 
 lngrück = Farbauswahl
 
 If lngrück = -1 Then
   MsgBox "Abbrechen wurde gedrückt."
 Else
   MsgBox lngrück
 End If

Wiki-Links

Weblinks


Der Code wurde in Access 2010 erstellt, ist aber auch in früheren Accessversionen lauffähig.