Microsoft Excel

Herbers Excel/VBA-Archiv

Sudoku Kontexmenü-Rechts [evtl. Hajo]

Betrifft: Sudoku Kontexmenü-Rechts [evtl. Hajo] von: Matthias L
Geschrieben am: 08.08.2008 21:58:35

Hallo
(Level bitte nicht ganz so ernst nehmen)

Folgendes:

In Diese Arbeitsmappe

Option Explicit
'nach einer Idee von Hajo Ziplies
'https://www.herber.de/forum/ _
archiv/972to976/t972675.htm


Private Sub Workbook_BeforeClose(Cancel As Boolean)
KontextmenueZuruecksetzen
End Sub

Private Sub Workbook_Open()
KontextmenueErgaenzen
End Sub



Ich möchte erreichen, das wenn ich die rechte Maustaste drücke um das Kontexmenü zu öffnen, das nur die noch möglichen Zahlen erscheinen.

Beim Klick in die Zelle mit der linken Maustaste habe ich es über Daten Gültigkeit gelöst.
siehe Bild






Nun möchte ich gern einen ähnlichen Effekt erzielen wenn ich die rechte Maustaste drücke.

in einem Modul nun folgender Code von Hajo
an meine Vorhaben angepasst

Option Explicit
'nach einer Idee von Hajo Ziplies
https://www.herber.de/forum/archiv/972to976/t972675.htm

Sub KontextmenueErgaenzen()
Dim oBtn As CommandBarButton
Dim InI As Integer
For InI = Application.CommandBars("Cell").Controls.Count To 1 Step -1
Application.CommandBars("Cell").Controls(1).Delete
Next InI

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "1" ' Beschriftung
.OnAction = "Eins" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "2" ' Beschriftung
.OnAction = "Zwei" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "3" ' Beschriftung
.OnAction = "Drei" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "4" ' Beschriftung
.OnAction = "Vier" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "5" ' Beschriftung
.OnAction = "Fünf" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "6" ' Beschriftung
.OnAction = "Sechs" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "7" ' Beschriftung
.OnAction = "Sieben" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "8" ' Beschriftung
.OnAction = "Acht" ' Aktion
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
.Caption = "9" ' Beschriftung
.OnAction = "Neun" ' Aktion
End With
End Sub

Sub Eins()
ActiveCell.Value = 1
End Sub

Sub Zwei()
ActiveCell.Value = 2
End Sub

Sub Drei()
ActiveCell.Value = 3
End Sub

Sub Vier()
ActiveCell.Value = 4
End Sub

Sub Fünf()
ActiveCell.Value = 5
End Sub

Sub Sechs()
ActiveCell.Value = 6
End Sub

Sub Sieben()
ActiveCell.Value = 7
End Sub

Sub Acht()
ActiveCell.Value = 8
End Sub

Sub Neun()
ActiveCell.Value = 9
End Sub

Sub KontextmenueZuruecksetzen()
On Error Resume Next
Application.CommandBars("Cell").Reset
End Sub




Bild2:


Wenn ich nun mit der rechten Maustaste eine Zahl wähle z.B. die Zahl 4 (in Worten "Vier")
diese dadurch in die Zelle geschrieben wird, so möchte ich beim erneutem Rechtsklick auf eine leere
Zelle in dieser Zeile, das diese Zahlen im Kontexmenue nicht mehr erscheinen
(so wie beim LinksKlick im oberen Bild.)

Kann mir bitte mal jemand das Brett vom Kopf wegnehmen ;o)


Besten Dank schon mal im Vorraus.
MfG Matthias L

  

Betrifft: AW: Sudoku Kontexmenü-Rechts [evtl. Hajo] von: Horst
Geschrieben am: 08.08.2008 22:02:36

Hi,

...und wenn du was in die nächste Zeile eingeben willst sollen wieder alle verfügbar sein, oder wie?


mfg Horst


  

Betrifft: Nein von: Matthias L
Geschrieben am: 08.08.2008 22:14:05

Hallo Horst

Danke für Deine schnelle Antwort.

In erster Linie ging es mir um die Zeile.

Wenn z.B. aber in der einer Spalte schon eine 5 steht, so sollte also auch im Menü dieser Spalte keine 5 mehr vorkommen.



Gruß Matthias L.


  

Betrifft: AW: Nein von: Gerd L
Geschrieben am: 08.08.2008 22:23:21

Hi Matthias,

nur mal so.

http://home.arcor.de/kdemmel

Gruß Gerd


  

Betrifft: ganz nett ... von: Matthias L
Geschrieben am: 08.08.2008 23:17:35

Hallo

Ja , danke für den Link (Interessant)
Aber im Moment, interessiert mich jetzt nur das rechte Kontexmenue des Beispiels.
Trotzdem Danke
Gruß Matthias


  

Betrifft: AW: ganz nett ... von: Gerd L
Geschrieben am: 09.08.2008 12:02:52

Hallo

Sub sperren_entsperren()
Dim i As Integer

For i = 1 To 9
With Application.CommandBars("Cell").Controls(i)
.Enabled = InStr(gesperrte, .Caption) = 0
.Visible = .Enabled
End With
Next

End Sub



Function gesperrte()
    gesperrte = "6,3,1,5"
End Function



Gruß Gerd


  

Betrifft: AW: Sudoku Kontexmenü-Rechts [evtl. Hajo] von: Daniel
Geschrieben am: 09.08.2008 14:41:41

Hi
das kann man doch einfach mit einer List-Box realisieren.
die Listbox muss sich halt auf die gleichen Daten beziehen wie die Gültigkeitsliste

guckst du beispiel: https://www.herber.de/bbs/user/54469.xls
Linker Klick - Gülitgkeitsliste
Rechter Klick - Listbox

Gruß. Daniel


  

Betrifft: AW: von: ransi
Geschrieben am: 09.08.2008 16:51:38

Hallo Matthias

Ein Reset auf mein selbstzusammengestelltes Kontextmenu finde ich gar nicht witzig....
;-)

Teste mal sowas:

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Private Sub Workbook_Deactivate()
Call loeschen
End Sub

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(ActiveCell, Range("B2:J10")) Is Nothing Then
    Application.CommandBars("Cell").Enabled = True
    Exit Sub
End If
Application.CommandBars("Cell").Enabled = False
Call erstellen
Application.CommandBars("Custom").ShowPopup
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit


Public Sub erstellen()
Dim mybar
Dim oBtn
Dim I As Integer
On Error Resume Next
Application.CommandBars("custom").Delete
On Error GoTo 0
Set mybar = CommandBars _
    .Add(Name:="Custom", Position:=msoBarPopup, Temporary:=False)
With mybar
    For I = 1 To 9
        If WorksheetFunction.CountIf(Range("B" & ActiveCell.Row & ":J" & ActiveCell.Row), I) = 0 Then
            Set oBtn = .Controls.Add
            With oBtn
                .Caption = I
                .OnAction = "Machs"
            End With
        End If
    Next
End With
End Sub


Public Sub machs()
ActiveCell = CommandBars.ActionControl.Caption
End Sub

Public Sub loeschen()
Application.CommandBars("Cell").Enabled = True
On Error Resume Next
Application.CommandBars("custom").Delete
End Sub


Tabelle1

 ABCDEFGHIJK
1           
2         7 
3 321   4   
4    342    
5           
6        2  
7           
8         2 
9 3  2      
10           
11           


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4


ransi


  

Betrifft: AW: ergänzung von: ransi
Geschrieben am: 09.08.2008 17:03:16

Hallo

Damit das Kontextmenu beim Blattwechsel wieder aktiviert wird...

Private Sub Worksheet_Deactivate()
Application.CommandBars("Cell").Enabled = True
End Sub


ransi


  

Betrifft: Danke an alle Helfer - Beitrag geschlossen ... von: Matthias L
Geschrieben am: 09.08.2008 20:51:50

Ein Hallo an Alle und Danke

Werde mich in den nächsten Tagen mal intensiver mit Euren Angeboten befassen.
Vielen Dank an Euch alle für die Beiträge.

Gruß Matthias