AW: dynamische Button-Click-Event für Tabelle
13.06.2010 21:47:18
Nepumuk
Hallo Pia,
in Tabellen ist es ein bisschen komplizierter da bein Einfügen eines ActiveX-Controls Excel ganz kurz in den Entwurfsmodus geht. Daher ist es nicht möglich die Zuweisung an die Klasse in der selben Prozedur zu machen. Des weiteren gehen durch diese Aktion die bisherigen Zuweisungen verloren und müssen neu aufgebaut werden. Hier mal ein Beispiel:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Terminate_CommandButtonClass
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef psa() As Any) As Long
Private objCommandButtonClass() As clsCommandButton
Public Sub Create_Sheet_and_Button()
Dim objWorksheet As Worksheet
Set objWorksheet = Worksheets.Add(After:=Sheets(Sheets.Count))
objWorksheet.OLEObjects.Add ClassType:="Forms.CommandButton.1", _
Left:=126, Top:=55, Width:=100, Height:=40
Application.OnTime Time + TimeSerial(0, 0, 1), "Initialize_CommandButtonClass"
Set objWorksheet = Nothing
End Sub
Private Sub Initialize_CommandButtonClass()
Dim objWorksheet As Worksheet, objOLEObject As OLEObject
Dim intCounter As Integer
For Each objWorksheet In Worksheets
For Each objOLEObject In objWorksheet.OLEObjects
If TypeOf objOLEObject.Object Is MSForms.CommandButton Then
Redim Preserve objCommandButtonClass(intCounter)
Set objCommandButtonClass(intCounter) = New clsCommandButton
Set objCommandButtonClass(intCounter).prpSet_CommandButton = objOLEObject.Object
intCounter = intCounter + 1
End If
Next
Next
Set objWorksheet = Nothing
Set objOLEObject = Nothing
End Sub
Public Sub Terminate_CommandButtonClass()
Dim intCounter As Integer
If Cbool(SafeArrayGetDim(objCommandButtonClass())) Then
For intCounter = LBound(objCommandButtonClass) To UBound(objCommandButtonClass)
Set objCommandButtonClass(intCounter) = Nothing
Next
End If
Erase objCommandButtonClass
End Sub
' **********************************************************************
' Modul: clsCommandButton Typ: Klassenmodul
' **********************************************************************
Option Explicit
Private WithEvents mobjCommandButton As MSForms.CommandButton
Friend Property Set prpSet_CommandButton(objCommandButton As MSForms.CommandButton)
Set mobjCommandButton = objCommandButton
End Property
Private Sub Class_Terminate()
Set mobjCommandButton = Nothing
End Sub
Private Sub mobjCommandButton_Click()
MsgBox "Hallo Pia"
End Sub
Gruß
Nepumuk