Dropdown für Hintergrundfarbe

[RPP63]

Das _BeforeRightClick() gehört ins Modul der Tabelle (steht auch in grün dort)!
(Rechtsklick auf Tabellenreiter, Code anzeigen)
Aufgerufen wird das Kontextmenue wie gewohnt, es sieht halt nur anders aus.

Gruß Ralf

[RPP63]

Ich habe Uwes Vorschlag mal (erweitert) umgesetzt.

[Runpoint86]

SUPER!!!!

Hat funktioniert....vielen Dank!!

Kann ich nun die Farben noch ein bisschen anpassen (z.B. etwas blasser, matter etc.) oder kann ich nur die aus der Liste weiter oben nutzen?

[RPP63]

Klar geht das!
Erstelle in einem allgemeinen Modul eine benutzerdefinierte Funktion:

Function Farbwert#(r As Range)
Farbwert = r.Interior.Color
End Function

Erstelle Deine gewünschten Farben in einer Tabelle und ermittle den Farbwert mit der UDF, die Du als normale Tabellenfunktion eingeben kannst:

	A	B
1	Farbe	Wert
2		11854022
3		13285804
4		14395790
5		6740479
6		24704

Zelle	Formel
B2	=Farbwert(A2)

Den Wert übernimmst Du dann als .Parameter =

Gruß Ralf

[Runpoint86]

ich muss aber doch dann bestimmt die FaceId wegnehmen oder? und für vbRed setze ich dann den Farbwert als Zahl ein?

          .FaceId = 6850
          .Caption = "Rot"
          .Parameter = vbRed
          .OnAction = "Hintergrundfarbe_setzen"

Wie bekomme ich es denn hin, dass wie im Beispiel oben nicht im ganzen Tabellenblatt, sondern nur in einem bestimmten Auschnitt die Farben eingestellt werden?

[RPP63]

Wie bekomme ich es denn hin, dass wie im Beispiel oben nicht im ganzen Tabellenblatt, sondern nur in einem bestimmten Auschnitt die Farben eingestellt werden?

Das siehst Du in meiner Datei!

Die Face-IDs sind vorgegeben, deren Farbe kann nicht geändert werden!

(es gibt wohl Anleitungen im Netz, per .CopyPicture und .PasteFace o.ä. ein Bild einer freien ID zuzuordnen, dies habe ich jedoch nur kurz erfolglos angetestet und mich dann den angenehmeren Dingen des Wochenendes zugewandt )

[Runpoint86]

Meinst du diesen Part vom Code?

Dim PicPath$: PicPath = Environ("UserProfile") & "\Desktop\cyan.gif"

If Intersect(Range("Kontext_Menue"), Target) Is Nothing Then Exit Sub

Ansonsten finde ich keine Angabe zur Größe des Bereiches

[RPP63]

Letzteres!
Ich habe dem umrahmten Bereich einen Namen gegeben.
Ersteres ist eine Code-Leiche.
Ich bin jetzt bis heute Abend offline.

[Runpoint86]

damit kann ich leider nicht so viel anfangen...es geht also nicht das ich vorgebe für welchen Bereich?
Also so z.B.: L12:N15?

[Kuwer]

Hallo,

(es gibt wohl Anleitungen im Netz, per .CopyPicture und .PasteFace o.ä. ...

wie hier z.B..

Das habe ich mal umgesetzt. Die Farben und deren Position im Menü werden im Sheet Farben festgelegt.
Der Bereich, in dem das Farbmenü bei Rechtsklick aufpoppt, ist jetzt auf Tabelle1 L12:N15 festgelegt.

Farben

	A	B
1	Position im Menü	Farbe
2	10
3	1
4	3
5	2
6	4
7	5
8	6
9	7
10	9
11	8

Microsoft Excel Objekt Tabelle1

Option Explicit 



Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 

 Dim lngZ As Long 

 Dim rngFarben As Range, rngP As Range 

 Dim varP As Variant 

 If Not Application.Intersect(Range("L12:N15"), Target) Is Nothing Then 

   Cancel = True 'verhindert die Anzeige des normalen Kontextmenüs 

   Set rngFarben = Worksheets("Farben").Cells(1, 1).CurrentRegion 

   On Error Resume Next 

   Application.CommandBars("MeineFarben").Delete 

   With Application.CommandBars.Add("MeineFarben", msoBarPopup, , True) 

     For lngZ = 1 To rngFarben.Rows.Count - 1 

       With .Controls.Add(msoControlButton) 

         varP = Application.Match(lngZ, rngFarben.Columns(1), 0) 

         If Not IsError(varP) Then 

           ' holt sich die Farbe aus der Arbeitsblatt Farben 

           Set rngP = rngFarben.Cells(varP, 2) 

           rngP.CopyPicture xlScreen, xlBitmap 

           .PasteFace 

           .Parameter = rngP.Interior.Color 

           .OnAction = "Hintergrundfarbe_setzen" 

         Else 

           .Parameter = xlNone 

           Err.Clear 

         End If 

       End With 

     Next lngZ 

     With .Controls.Add(msoControlButton) 

       .FaceId = 6849 

       '.Caption = "Farblos" 

       .Parameter = -4142 

       .OnAction = "Hintergrundfarbe_setzen" 

     End With 

     .ShowPopup 

     .Delete 

   End With 

 End If 

End Sub 



VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Modul Modul1

Option Explicit 

Option Private Module 



Sub Hintergrundfarbe_setzen() 

 Selection.Interior.Color = Application.CommandBars.ActionControl.Parameter 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

  Farbauswahl per Kontextmenue Kuwer.xlsm (Größe: 20,61 KB / Downloads: 9)


Gruß Uwe