Rechte Maustaste

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Paule,
du hast Glück, das meine Glaskugel heute funktioniert. Beschreibe bitte das nächste mal dein Problem etwas präziser.
Nimm diesen Code.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Activate()
If ActiveSheet Is Tabelle1 Then
    kontext
End If
End Sub

Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh Is Tabelle1 Then
    kontext
End If
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh Is Tabelle1 Then Application.CommandBars("Cell").Reset
End Sub

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

Option Explicit

Sub eintrag(ByVal str As String)
If Not Intersect(ActiveCell, Range("A1:A10,B1:B5")) Is Nothing Then
    ActiveCell = UCase(str)
End If
End Sub

Sub kontext()
Dim oBtn As CommandBarButton

With Application.CommandBars("Cell")
    On Error Resume Next
    While .Controls.Count > 0
        .Controls(1).Delete
    Wend
End With

Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
    .Caption = "U = Urlaub"
    .OnAction = "'eintrag ""u""'"
End With
Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
    .Caption = "K = Krank"
    .OnAction = "'eintrag ""k""'"
End With
Set oBtn = Application.CommandBars("Cell").Controls.Add
With oBtn
    .Caption = "F = Freizeit"
    .OnAction = "'eintrag ""f""'"
End With
End Sub

Gruß Sepp

Hallo Paule,
alles geht.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Activate()
If ActiveSheet.Name = "Tabelle1" Then
    kontext "Urlaub,Krank,Freizeit", "u,k,f", "100,90,85"
ElseIf ActiveSheet.Name = "Tabelle2" Then
    kontext "Urlaub,Krank,Freizeit", "2,3,4", "72,73,74"
End If
End Sub

Private Sub Workbook_Deactivate()
Application.CommandBars("Cell").Reset
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "Tabelle1" Then
    'Parameter: "Menüenintrag1,Menüeintrag2,...", "Zelleintrag1,Zelleintrag2,...", "Menüicon1,Menüicon2,..."
    kontext "Urlaub,Krank,Freizeit", "u,k,f", "100,90,85"
ElseIf ActiveSheet.Name = "Tabelle2" Then
    kontext "Urlaub,Krank,Freizeit", "2,3,4", "72,73,74"
End If
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = "Tabelle1" Or Sh.Name = "Tabelle2" Then Application.CommandBars("Cell").Reset
End Sub

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

Sub eintrag(ByVal str As String)
Dim rng As Range
For Each rng In Selection
    If Not Intersect(rng, Range("A1:A10,B1:B5")) Is Nothing Then
        rng = UCase(str)
    End If
Next
End Sub

Sub kontext(MenuEntries As String, Values As String, Faces As String)
Dim oBtn As CommandBarButton
Dim vEntries As Variant, vValues As Variant, vFaces As Variant
Dim intIndex As Integer

With Application.CommandBars("Cell")
    On Error Resume Next
    While .Controls.Count > 0
        .Controls(1).Delete
    Wend
End With

vEntries = Split(MenuEntries, ",")
vValues = Split(Values, ",")
vFaces = Split(Faces, ",")

For intIndex = 0 To UBound(vEntries)
    Set oBtn = Application.CommandBars("Cell").Controls.Add
    With oBtn
        .Caption = vEntries(intIndex)
        .OnAction = "'eintrag """ & vValues(intIndex) & """'"
        .FaceId = Clng(vFaces(intIndex))
    End With
Next

Set oBtn = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread