AW: Makro Ein/Ausschalten
09.11.2009 17:25:00
Nepumuk
Hallo,
mal ein Beispiel wie so etwas geht:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Terminate_Class
Call Delete_Buttons
End Sub
Private Sub Workbook_Open()
Call Initialize_Class
Call Create_Buttons
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Option Private Module
Private Const COMMANDBARBUTTON_TAG = "Schalter"
Private lobjApplication As clsApplication
Private lobjCommandbarButton(1 To 2) As CommandBarButton
Public Sub Initialize_Class()
Set lobjApplication = New clsApplication
Set lobjApplication.Set_Application = Application
End Sub
Public Sub Terminate_Class()
Set lobjApplication = Nothing
End Sub
Public Sub Create_Buttons()
Dim intIndex As Integer
Call Delete_Buttons
For intIndex = 1 To 2
Set lobjCommandbarButton(intIndex) = CommandBars(intIndex). _
Controls.Add(Type:=msoControlButton, Temporary:=True)
With lobjCommandbarButton(intIndex)
.Caption = "Ein"
.OnAction = "Switch_ActiveCell_Color"
.TooltipText = "Ein- und Ausschalten der automatischen Hervorhebung"
.Style = msoButtonCaption
.Tag = COMMANDBARBUTTON_TAG
End With
Next
End Sub
Public Sub Delete_Buttons()
Dim intIndex As Integer
Dim objCommandbarButton As CommandBarButton
For intIndex = 1 To 2
Set objCommandbarButton = CommandBars(intIndex). _
FindControl(Tag:=COMMANDBARBUTTON_TAG)
If Not objCommandbarButton Is Nothing Then objCommandbarButton.Delete
Set lobjCommandbarButton(intIndex) = Nothing
Next
End Sub
Public Sub Switch_ActiveCell_Color()
Dim intIndex As Integer
For intIndex = 1 To 2
lobjCommandbarButton(intIndex).Caption = _
IIf(lobjCommandbarButton(intIndex).Caption = "Ein", "Aus", "Ein")
Next
Call lobjApplication.Switch_On_Off
End Sub
' **********************************************************************
' Modul: clsApplication Typ: Klassenmodul
' **********************************************************************
Option Explicit
Private WithEvents mobjApplication As Excel.Application
Private mblnOn As Boolean
Private mobjCell As Range
Private mintColorIndex As Integer
Friend Property Set Set_Application(objApplication As Excel.Application)
Set mobjApplication = objApplication
End Property
Private Sub Class_Terminate()
If Not mobjCell Is Nothing Then
mobjCell.Interior.ColorIndex = mintColorIndex
Set mobjCell = Nothing
End If
Set mobjApplication = Nothing
End Sub
Private Sub mobjApplication_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If mblnOn Then
If Not Target.Locked Or Not Sh.ProtectContents Then
If Not mobjCell Is Nothing Then _
mobjCell.Interior.ColorIndex = mintColorIndex
mintColorIndex = Target.Interior.ColorIndex
Target.Interior.ColorIndex = 6
Set mobjCell = Target
End If
End If
End Sub
Friend Sub Switch_On_Off()
mblnOn = Not mblnOn
If Not mblnOn And Not mobjCell Is Nothing Then _
mobjCell.Interior.ColorIndex = mintColorIndex
End Sub
Gruß
Nepumuk