Thema: Markierung des jeweils aktuellen Datums

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   On Error Resume Next
   Application.CommandBars("Standard").Controls("Multiplizieren").Delete
   On Error GoTo 0
End Sub

Private Sub Workbook_Open()
   Dim objButton As CommandBarButton
   On Error Resume Next
   Application.CommandBars("Standard").Controls("Multiplizieren").Delete
   On Error GoTo 0
   Set objButton = Application.CommandBars("Standard").Controls.Add
   With objButton
      .Caption = "Multiplizieren"
      .Style = msoButtonIcon
      .FaceId = 1088
      .OnAction = "Multiplizieren"
   End With
End Sub

ClassModule: Tabelle3

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   Dim rngAct As Range
   If Application.CommandBars("Standard") _
      .Controls("Multiplizieren").State = msoButtonDown Then
      If Target.Column <> 3 Then
         Beep
         MsgBox "Sie müssen Zellen in Spalte C markieren!"
         Exit Sub
      End If
      For Each rngAct In Selection.Cells
         rngAct = rngAct.Offset(0, -1) * dMultiplicator
         rngAct.Offset(0, 1) = rngAct.Offset(0, -1) + rngAct
      Next rngAct
   End If
   Application.CommandBars("Standard") _
      .Controls("Multiplizieren").State = msoButtonUp
End Sub

StandardModule: basMain

Public dMultiplicator As Double

Sub Multiplizieren()
   If Intersect(ActiveCell, Range("A2:A6")) Is Nothing Then
      Beep
      MsgBox "Sie müssen sich im Bereich A2:A6 befinden!"
      Exit Sub
   End If
   If Selection.Cells.Count > 1 Then
      Beep
      MsgBox "Es darf nur eine Zelle markiert sein!"
      Exit Sub
   End If
   CommandBars("Standard").Controls("Multiplizieren").State = msoButtonDown
   dMultiplicator = ActiveCell
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Zelle