|
Hi Leute, bin noch sehr neu, was Klassenmodule angeht, aber irgendwie geht eines in meinen Kopf nicht rein und ich finde einfach seit Stunden keinen Weg :/
Das hier steht bei mir in der Klasse drin,
Option Explicit
Public WithEvents DelEvent As MSForms.Image
Private Sub DelEvent_click()
Application.ScreenUpdating = False
Dim x As Integer
ItemNumber = ((DelEvent.Top - 14) / 30)
ItemNumber = ItemNumber + 1
RolesDisciplines.Controls.Remove ("TextBox" & ItemNumber)
RolesDisciplines.Controls.Remove ("Minus" & ItemNumber)
If ItemNumber < ItemRange Then
For x = ItemNumber To ItemRange - 1
RolesDisciplines.Controls("TextBox" & x + 1).Move 12, RolesDisciplines.Controls("TextBox" & x + 1).Top - 30
RolesDisciplines.Controls("Minus" & x + 1).Move 272, RolesDisciplines.Controls("Minus" & x + 1).Top - 30
RolesDisciplines.Controls("TextBox" & x + 1).Name = "TextBox" & x
RolesDisciplines.Controls("Minus" & x + 1).Name = "Minus" & x
Next x
End If
RolesDisciplines.Controls("Plus").Move 272, RolesDisciplines.Controls("Plus").Top - 30
ItemRange = ItemRange - 1
RolesDisciplines.Height = RolesDisciplines.Height - 30
Erase DelArray
For x = 0 To ItemRange - 1
ReDim Preserve DelArray(x)
DelArray(x).DelEvent = RolesDisciplines.Controls.Item("Minus" & x + 1)
Next x
Application.ScreenUpdating = False
End Sub
Das in der UserForm:
Private Sub UserForm_Initialize()
Dim RD As Object
Set RD = RolesDisciplines
ItemNumber = 1
yDD = 2
TopCounter = 12
RD.BackColor = RGB(255, 255, 255)
Dim x As Integer
Dim LineCounter As Integer
LineCounter = 37
Dim CodeModule As Object
If Roles = True Then
x = 1
Else
x = 3
End If
Do While Sheets("Dropdown Menu").Cells(yDD, x).Value <> Empty
Set NewTB = RD.Controls.Add("Forms.TextBox.1")
Set NewMinus = RD.Controls.Add("Forms.Image.1")
With NewTB
.Left = 12
.Top = TopCounter
.Width = 250
.Text = Sheets("Dropdown Menu").Cells(yDD, x).Value
.BackColor = RGB(30, 100, 130)
.BorderStyle = fmBorderStyleNone
.Font = "Bahnschrift SemiLight Condensed"
.Font.Size = 16
.ForeColor = RGB(255, 255, 255)
.SpecialEffect = fmSpecialEffectFlat
.Height = 24
.Name = "TextBox" & ItemNumber
End With
With NewMinus
.Left = 272
.Top = TopCounter + 2
.Width = 21
.Height = 21
.BorderStyle = fmBorderStyleNone
.BackColor = RGB(255, 255, 255)
.Picture = RD.Minus.Picture
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.Name = "Minus" & ItemNumber
End With
ReDim Preserve DelArray(yDD - 2)
Set DelArray(yDD - 2).DelEvent = NewMinus
LineCounter = LineCounter + 12
TopCounter = TopCounter + 30
yDD = yDD + 1
ItemNumber = ItemNumber + 1
Loop
ItemRange = ItemNumber - 1
Me.Height = TopCounter + 65
Me.Plus.Top = TopCounter + 2
Me.Show
End Sub
Und die Variablen hier sind nochmal in einem anderen Modul definiert:
Public ItemCounter As Integer
Public Roles As Boolean
Public ItemRange As Integer
Public ItemNumber As Integer
Public DelArray() As New DelEventClass
Public CacheDelArray() As New DelEventClass
Public NewTB As MSForms.TextBox
Public NewMinus As MSForms.Image
Aus irgendeinem Grund gibt mir VBA bei der Klasse bei der Zeile:
DelArray(x).DelEvent = RolesDisciplines.Controls.Item("Minus" & x + 1)
den Fehler "Objektvariable oder With-Blockvariable nicht festgelegt" aus. Wieso? Die Variable DelEvent ist vom Typ Image und auch RolesDisciplines.Controls.Item("Minus" & x + 1) ist vom Typ Image. Vor allem funktioniert der selbe Befehl in der Userform selbst ohne Probleme, nachdem, das Image erstellt wurde. Habe versucht, zwei Arrays aus derselben Klasse zu erstellen, aber auch zwischen denen kann ich die Daten nicht hin und her transferieren. Muss aber irgendwie aus dem Array die leeren Felder rausbekommen, sobald die Images in der UserForm gelöscht wurden, sonst funktioniert das ganze nicht dynamisch :/
Jemand eine Ahnung oder schonmal mit dem selben Problem zu kämpen gehabt?
Viele Grüße
Ray :)
|