Benutzerdef. Zell-Kontextmenü, OnAction



Excel-Version: Ab 8.0
nach unten

Betrifft: Benutzerdef. Zell-Kontextmenü, OnAction
von: Rolf, Lgh.
Geschrieben am: 08.07.2002 - 19:23:25

Hallo Excel- und VBA-Freunde,
ich habe zum nachfolgenden Makro mal zwei Fragen:
1. Kann ich mir das Select Case oBtn.Index ersparen bzw. das gleiche Ergebnis einfacher erreichen
und / oder
2. Kann ich an das aufrufende Makro eine Variable übergeben?
Dann könnte ich mir das Schreiben von fast identischen
Standardmodulen sparen und das ganze wäre noch variabler (es ändert sich jeweils nur der Zellbezug).

Option Explicit

Private Sub Worksheet_Activate()
  Dim oBar As CommandBar
  Dim oBtn As CommandBarButton
  Dim icounter As Integer
  On Error Resume Next
  Application.CommandBars("Fehltage").Delete
  On Error GoTo 0
  Set oBar = Application. _
             CommandBars. _
             Add("Fehltage", msoBarPopup, False, True)
  For icounter = 1 To 11
    Set oBtn = oBar.Controls.Add
    With oBtn
      .Caption = Worksheets(4).Cells(icounter + 1, 1) _
               & " (" & Worksheets(4).Cells(icounter + 1, 2) & ")"
      .Style = msoButtonCaption
      Select Case oBtn.Index
      Case 1
        oBtn.OnAction = "EintrFehl1"
      Case 2
        oBtn.OnAction = "EintrFehl2"
      Case 3
        oBtn.OnAction = "EintrFehl3"

        'usw.

      End Select
    End With
  Next icounter
  Set oBtn = oBar.Controls.Add
  With oBtn
    .Caption = ">>> Eintragungen löschen <<<"
    .Style = msoButtonCaption
    .OnAction = "EintrLösch"
  End With
End Sub

'######################

'Standard-Modul
Option Explicit

Private Sub EintrFehl1()
  With Selection.Interior
    .ColorIndex = Worksheets(4).Cells(2, 2).Interior.ColorIndex
    .Pattern = Worksheets(4).Cells(2, 2).Interior.Pattern
    .PatternColorIndex = Worksheets(4).Cells(2, 2).Interior.PatternColorIndex
  End With
  With Selection.Font
    .FontStyle = "Fett"
    .ColorIndex = Worksheets(4).Cells(2, 2).Font.ColorIndex
  End With
  Selection.Value = Worksheets(4).Cells(2, 2).Value
End Sub

Für jede Idee wäre ich dankbar!
Gruß Rolf

nach oben   nach unten

Re: Benutzerdef. Zell-Kontextmenü, OnAction
von: Hans W Hofmann
Geschrieben am: 08.07.2002 - 20:34:48

Zu Deinem Case-Problem
Dim a
a=Array("EintrFehl1","EintrFehl2","EintrFehl3")
oBtn.OnAction=a(oBtn.Index)

Gruß HW


nach oben   nach unten

mit der Frage die Lösungs-Idee gehabt ...
von: Rolf, Lgh.
Geschrieben am: 08.07.2002 - 20:54:31

Trotzdem vielen Dank!
:-)
Die Lösung (Application.Caller(1)):

Option Explicit
Private Sub Worksheet_Activate()
  Dim oBar As CommandBar
  Dim oBtn As CommandBarButton
  Dim icounter As Integer
  On Error Resume Next
  Application.CommandBars("Fehltage").Delete
  On Error GoTo 0
  Set oBar = Application. _
             CommandBars. _
             Add("Fehltage", msoBarPopup, False, True)
  For icounter = 1 To 11
    Set oBtn = oBar.Controls.Add
    With oBtn
      .Caption = Worksheets(4).Cells(icounter + 1, 1) _
               & " (" & Worksheets(4).Cells(icounter + 1, 2) & ")"
      .Style = msoButtonCaption
      .OnAction = "EintrFehl"
    End With
  Next icounter
  Set oBtn = oBar.Controls.Add
  With oBtn
    .Caption = ">>> Eintragungen löschen <<<"
    .Style = msoButtonCaption
    .OnAction = "EintrLösch"
  End With
End Sub

'########################

'Standard-Modul
Option Explicit

Private Sub EintrFehl()
  Dim icounter As Integer
  icounter = Application.Caller(1)
  With Selection.Interior
    .ColorIndex = Worksheets(4).Cells(icounter + 1, 2).Interior.ColorIndex
    .Pattern = Worksheets(4).Cells(icounter + 1, 2).Interior.Pattern
    .PatternColorIndex = Worksheets(4).Cells(icounter + 1, 2).Interior.PatternColorIndex
  End With
  With Selection.Font
    .FontStyle = "Fett"
    .ColorIndex = Worksheets(4).Cells(icounter + 1, 2).Font.ColorIndex
  End With
  Selection.Value = Worksheets(4).Cells(icounter + 1, 2).Value
End Sub


Gruß Rolf
 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Neue Symbolleiste per VBA"