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