Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1764to1768
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Klassenmodul

Klassenmodul
16.06.2020 16:21:28
Ma
Hallo liebe Excel-Freunde,
ich möchte mit Hilfe eines Klassenmoduls ein Makro für mehrere Comboboxen bedienen wenn ein Eintrag ausgewählt wurde. Dabei kann die Anzahl der Comboboxen durch ein Steuerelement "Drehfeld" erhöht und wieder verringert werden.
Mein Problem hierbei ist, das nach dem Ausführen des Drehfeld-Makros das Klassenmakro für die Comboboxen nicht mehr funktioniert.
Habe dazu die Datei angehängt. Vielleicht weiß einer warum sich die Prozedur "verliert"?
https://www.herber.de/bbs/user/138342.xlsm
LG
Ma

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Klassenmodul
16.06.2020 16:44:37
Nepumuk
Hallo Marco,
wenn due ein ActiveX-Control auf einer Tabelle einfügst oder löschst, wechselt Excel kurz in den Entwurfsmodus. Dabei werden alle Variablen gelöscht, inklusive deines Klassenarrays. Du musst das Initialisieren des Arrays per OnTime-Methode von der Einfüge- Löschprozedur entkoppeln. Dazu muss sich die Initialisierungsroutine als öffentliche Prozedur in einem Standardmodul befinden.
Gruß
Nepumuk
AW: Klassenmodul
16.06.2020 17:21:46
Luschi
Hallo Marco,
in solchen fällen halte ich eine gewisse Reserve an ActiveX-Controls vor, entsprechend sichtbar oder versteckt sind. Ob sich der angedeutete Weg von Nepumuk aufwandsmäßig/wartungstechnisch lohnt, mußt Du entscheiden.
Bei mir gibt es eine Höchstgrenze der möglichen Steuerelemente und es zeigt sich, das der Anwender dann auch überlegt, ob weitere Steuerelemente notwendig sind.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Klassenmodul
17.06.2020 12:26:24
Ma
Danke Nepumuk und Luschi für die Antworten.
Zu Nepumuks Antwort. D.h., dass die Prozedur zur Erhaltung der Klassenarrays nach einer bestimmten Zeit immer wieder ausgeführt wird?
Habe auch schon versucht die Prozedur "subTblBerRingStandardCboOneClickEvent" zur Festlegung der Klassenarrays am Ende des SpinUp subs zu setzen. Jedoch wird scheinbar die Prozedur nicht zur Festlegung der Klassenarrays ausgeführt, da die Comboboxen nicht die Prozedur im Klassenmodul ausführen. Was dabei funktioniert ist das die Comboboxen gefüllt werden. Woran liegt das?
AW: Klassenmodul
17.06.2020 15:02:42
Nepumuk
Hallo Marco,
du musst die Prozedur "subTblBerRingStandardCboOneClickEvent" per OnTime aufrufen.
Application.OnTime Now, "subTblBerRingStandardCboOneClickEvent"
und dazu muss die Prozedur in ein Standardmodul und öffentlich sein.
Gruß
Nepumuk
Anzeige
AW: Klassenmodul
17.06.2020 16:43:46
Ma
Danke Nepumuk, hat wunderbar geklappt :)
Hier nochmal der Code:
Code im Tabellenblatt für das AktiveX Steuerelement "Drehfeld":
Public Sub spnRing_SpinUp()
Dim intMaxZeile As Integer
Dim lngMaxSpalte As Long
Dim intRingCount As Integer
Dim intCboCount As Integer
Dim shpCbo1 As OLEObject, shpCbo2 As OLEObject
Dim strCboName1 As String, strCboName2 As String
Application.ScreenUpdating = False
With tblBerRingStandard
'Timer zur Auslösung der Prozedur für die Festlegung der Klassenarrays
Application.OnTime Now + TimeSerial(0, 0, 1), "subTblBerRingStandardCboOneClickEvent"
intMaxZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngMaxSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
intRingCount = Int(Right(.Cells(12, lngMaxSpalte).Value, 2))
.spnRing.Value = intRingCount
.spnRing.Max = intRingCount + 1
.spnRing.Top = 188
.spnRing.Left = .Cells(12, lngMaxSpalte + 3).Left + 5
'Zellenformatierung
.Range(.Cells(, lngMaxSpalte + 1), .Cells(, lngMaxSpalte + 1)).ColumnWidth = 0.5
.Range(.Cells(, lngMaxSpalte + 2), .Cells(, lngMaxSpalte + 2)).ColumnWidth = 15
.Range(.Cells(10, lngMaxSpalte - 1), .Cells(44, lngMaxSpalte)).Copy .Range(.Cells(10,  _
lngMaxSpalte + 1), .Cells(44, lngMaxSpalte + 2))
.Cells(12, lngMaxSpalte + 2).Value = .OLEObjects("cboForm" & intRingCount).Object.Value & "  _
" & intRingCount + 1
'Duplizierung der Comboboxen
For intCboCount = 1 To 5
Select Case intCboCount
Case 1
strCboName1 = "cboForm1"
strCboName2 = "cboForm" & intRingCount + 1
Case 2
strCboName1 = "cboSorte1"
strCboName2 = "cboSorte" & intRingCount + 1
Case 3
strCboName1 = "cboStein1"
strCboName2 = "cboStein" & 1 + ((intRingCount) * 3)
Case 4
strCboName1 = "cboStein2"
strCboName2 = "cboStein" & 2 + ((intRingCount) * 3)
Case 5
strCboName1 = "cboStein3"
strCboName2 = "cboStein" & 3 + ((intRingCount) * 3)
End Select
Set shpCbo1 = .OLEObjects(strCboName1)
Set shpCbo2 = shpCbo1.Duplicate
shpCbo2.Name = strCboName2
shpCbo2.Top = shpCbo1.Top
shpCbo2.Left = .Cells(12 + intCboCount, lngMaxSpalte + 2).Left + 0.8
Next intCboCount
End With
Application.ScreenUpdating = True
End Sub
_____________________________________________________________________________
Sub spnRing_SpinDown()
Dim intMaxZeile As Integer
Dim lngMaxSpalte As Long
Dim intRingCount As Integer
Dim intCboCount As Integer
Dim strCboName As String
Application.ScreenUpdating = False
With tblBerRingStandard
intMaxZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngMaxSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
intRingCount = Int(Right(.Cells(12, lngMaxSpalte).Value, 2))
.spnRing.Min = 1
.spnRing.Value = intRingCount
If .spnRing.Value = 1 Then Exit Sub
.Range(Columns(lngMaxSpalte - 1), Columns(lngMaxSpalte)).Delete
'Timer zur Auslösung der Prozedur für die Festlegung der Klassenarrays
Application.OnTime Now + TimeSerial(0, 0, 2), "subTblBerRingStandardCboOneClickEvent"
For intCboCount = 1 To 5
Select Case intCboCount
Case 1
strCboName = "cboForm" & intRingCount
Case 2
strCboName = "cboSorte" & intRingCount
Case 3
strCboName = "cboStein" & 1 + ((intRingCount - 1) * 3)
Case 4
strCboName = "cboStein" & 2 + ((intRingCount - 1) * 3)
Case 5
strCboName = "cboStein" & 3 + ((intRingCount - 1) * 3)
End Select
.OLEObjects(strCboName).Delete
Next intCboCount
End With
Application.ScreenUpdating = False
End Sub
Code zum setzten der Klassenarrays in einem Standardmodul:
Public Sub subTblBerRingStandardCboOneClickEvent()
Dim intCount As Integer
Dim intMaxComboBox As Integer
Dim intComboBox As Integer
intMaxComboBox = Int(Right(tblBerRingStandard.Cells(12, tblBerRingStandard.UsedRange. _
SpecialCells(xlCellTypeLastCell).Column), 2))
ReDim Preserve arrComboBoxAuswahlRingform(1 To intMaxComboBox)
For intComboBox = 1 To intMaxComboBox
Set arrComboBoxAuswahlRingform(intComboBox).ctlComboBoxAuswahlRingform = tblBerRingStandard. _
OLEObjects("cboForm" & intComboBox).Object
tblBerRingStandard.OLEObjects("cboForm" & intComboBox).Object.List = Array("Ring", "Konus")
Next intComboBox
End Sub
Ein Makro zur Bedienung von mehreren ComboBoxen in einem Klassenmodul:
Option Explicit
Public WithEvents ctlComboBoxAuswahlRingform As MSForms.ComboBox
Sub ctlComboBoxAuswahlRingform_Click()
'Hier steht dein Code
End Sub

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige