Zelle mit Farbpalette färben ohne select?

Public Sub Fahrzeugfarbe_Click() 'Beim Auswählen der Fahrzeugfarbe Dim rot3 As Long, grün3 As Long, blau3 As Long, wert As Long Dim X As Long Application.ScreenUpdating = False 'Sheets("Daten").Visible = True Worksheets(Projekt_Auswahl & " Fahrzeuge").Activate 'Blatt Fahrzeug wird aktiviert X = Worksheets(Projekt_Auswahl & " Fahrzeuge").Cells(3, 256).End(xlToLeft).Column _ _ _ _ 'Letzte Spalte ermitteln Worksheets(Projekt_Auswahl & " Fahrzeuge").Cells(2, X + 1).Select 'Neu anzulegendes _ Fahrzeug wird Farbe zugewiesen Application.Dialogs(xlDialogPatterns).Show 'Farbe an Userform-Auswahlbutton zurück geben wert = ActiveCell.Interior.Color Fahrzeugfarbe.BackColor = wert Application.ScreenUpdating = True 'Sheets("Daten").Visible = False End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Ralph,
im Prinzip so:

Option Explicit

Private Declare PtrSafe Function ChooseColorA Lib "comdlg32.dll" ( _
    ByRef pChoosecolor As CHOOSECOLOR) As Long

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    rgbResult As Long
    lpCustColors As LongPtr
    flags As Long
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
Private Const CC_ANYCOLOR = &H100

Public Sub test()
    Dim udtChooseColor As CHOOSECOLOR
    Dim lngReturn As Long
    Dim alngUserColor(15) As Long

    'Benutzerdefinierte Farben
    alngUserColor(0) = RGB(255, 0, 0)
    alngUserColor(1) = RGB(125, 125, 125)
    alngUserColor(2) = RGB(90, 90, 90)
    alngUserColor(3) = RGB(255, 90, 90)
    alngUserColor(4) = RGB(255, 255, 255)
    alngUserColor(5) = RGB(192, 192, 192)

    With udtChooseColor
        .lStructSize = Len(udtChooseColor)
        .hwndOwner = CLngPtr(Application.Hwnd)
        .hInstance = CLngPtr(Application.hInstance)
        .rgbResult = RGB(255, 0, 0)
        .lpCustColors = CLngPtr(VarPtr(alngUserColor(0)))
        .flags = CC_RGBINIT Or CC_ANYCOLOR Or CC_FULLOPEN
    End With
    lngReturn = ChooseColorA(udtChooseColor)
    If lngReturn <> 0 Then
        Worksheets(Projekt_Auswahl & " Fahrzeuge").Cells(2, X + 1).Interior.Color = udtChooseColor.rgbResult
    Else
        Call MsgBox("Abbrechen gedrückt", vbExclamation, "Hinweis")
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Zelle mit Farbpalette färben ohne select?

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelle mit Farbpalette färben ohne select?

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread