Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Farbauswahldialog generieren, aufrufen und löschen

Gruppe

DialogSheet

Problem

Wie kann ich auf Schaltflõchendruck ein Dialogblatt zur Farbauswahl generieren, den Dialog aufrufen, Farben auswõhlen und das Dialogblatt wieder l÷schen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Public clrArt As Boolean

Sub ColorPicker()
  Dim dlgFarben As DialogSheet
  Dim btnOK As Button, btnCancel As Button
  Dim optInterior As OptionButton, optFont As OptionButton
  Dim txtClr As TextBox
  Dim intRow As Integer, intCol As Integer
  Dim l As Integer, t As Integer, intClr As Integer
  Application.ScreenUpdating = False
  Set dlgFarben = DialogSheets.Add
  With dlgFarben
    .Name = "dlgFarben"
    With .DialogFrame
      .Top = 0
      .Left = 0
      .Height = 200
      .Width = 170
      .Caption = "Color Picker"
    End With
    l = 15
    t = 15
    Set optInterior = .OptionButtons.Add(l, t, 75, 15)
    optInterior.Caption = "Zellhintergrund"
    optInterior.Value = xlOn
    Set optFont = .OptionButtons.Add(l + 75, t, 75, 15)
    optFont.Caption = "Schriftfarbe"
    t = t + 20
    For intRow = 1 To 7
      l = 15
      For intCol = 1 To 8
        intClr = intClr + 1
        Set txtClr = .TextBoxes.Add(l, t, 16, 16)
        With txtClr
          .Interior.ColorIndex = intClr
          .OnAction = "FarbAuswahl"
          .Name = "clr" & intClr
        End With
        l = l + 18
      Next intCol
      t = t + 18
    Next intRow
    Set btnOK = .Buttons(1)
    Set btnCancel = .Buttons(2)
    btnOK.Top = 180
    btnOK.Left = 25
    btnCancel.Top = 180
    btnCancel.Left = 100
    Worksheets(1).Select
    .Show
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
  End With
End Sub

Sub FarbAuswahl()
  Dim strAc As String
  Worksheets("Tabelle1").Select
  Application.ScreenUpdating = True
  strAc = Application.Caller
  If DialogSheets("dlgFarben").OptionButtons(1).Value = xlOn Then
    Selection.Interior.ColorIndex = CInt(Right(strAc, Len(strAc) - 3))
  Else
    Selection.Font.ColorIndex = CInt(Right(strAc, Len(strAc) - 3))
  End If
End Sub