Dynamisches ChangeEreignis MultiPage will nicht
20.01.2019 14:03:11
Zwenn
ich baue eine UserForm dynamisch auf. Diese kann eine oder zwei Multipages enthalten, die dann übereinander angeordnet werden. Für die untere MultiPage benötige ich das ChangeEvent, um auf einen Page-Wechsel reagieren zu können.
Da die UserForm dynamisch generiert wird, müssen auch die Ereignisse für die Controls dynamisch zugewiesen werden. Das klappt für Buttons, Textboxen, usw. auch ganz hervorragend. Für die untere Multipage funktioniert das eigentlich auch. Solange ich die einfach nur erzeuge und dann die Pages wechsle, wird das Event ausgelöst wie es soll.
Aber natürlich will ich auf dem Teil auch Controls platzieren, usw. Sobald der dynamische Aufbau der UserForm also weitergehen soll, bekomme ich bereits beim Kompilieren die Fehlermeldung Methode oder Datenobjekt nicht gefunden, sobald ich mit Pages etwas anstellen will.
Kann mir jemand erklären, warum das so ist, bzw. wie ich den Fehler vermeiden und ganz normal weiterarbeiten kann? Es ist so, als gehen die Pages-Objekte beim antackern des Change-Events verloren. Wie bekomme ich die wieder?
Hier ist eine Beispielmappe mit beiden Zuständen:
https://www.herber.de/bbs/user/126950.xlsm
Für diejenigen, die keine xlsm Arbeitsmappen runterladen möchten folgt der Code. Ich habe schon alles rausgeschmissen, was für das vorliegende Problem nicht benötigt wird.
Zunächst für die funktionierende Methode:
Code für Modul1:
Option Explicit
'Windows API zur Ermittlung der Bildschirmauflösung nutzen
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Sub UserFormGenerierenGeht()
UserForm1.Show
End Sub
Sub UserFormGenerierenFail()
UserForm2.Show
End Sub
Ins Klassenmodul clsMultiPageChangeEvent1:
Option Explicit
Public WithEvents MultiPageChangeGeht As MSForms.MultiPage
Private Sub MultiPageChangeGeht_Change()
MsgBox UserForm1.Controls("Multipage2").Value
End Sub
Code der UserForm1:
Option Explicit
Dim multiPageUntenGeht As clsMultiPageChangeEvent1
Private Sub UserForm_Initialize()
'Variablen für die UserForm
Dim breiteUF As Long
Dim hoeheUF As Long
Dim multiPageOben As Control
Dim multiPageTemp As Control
'Sonstige Variablen
Dim pageDaten As Object
Dim i As Long
Dim einmal As Boolean
'Userform abhängig von der Bildschirmauflösung skalieren
Me.Width = GetSystemMetrics(SM_CXSCREEN) / 2
Me.Height = GetSystemMetrics(SM_CYSCREEN) * 0.7
'Höhe und Breite der UserForm als Berechnungsgrundlage
'für die Positionierung der Steuerelemente
breiteUF = Me.Width
hoeheUF = Me.Height
'Seiten für die Multipages feststellen
'In der Feld-Konfigurations-Tabelle sind:
' -die Reihenfolge der Pages in Spalte C festgelegt
' -die Namen der Pages in Spalte D festgelegt
Set pageDaten = CreateObject("Scripting.Dictionary")
'Manuelle Beispielfüllung
pageDaten.Add 0, "Page1"
pageDaten.Add 1, "Page2"
pageDaten.Add 2, "Page3"
'ReDim nextPlace(pageDaten.Count)
'Erzeugung von bis zu zwei Multipages übereinander
'Die obere soll nur die Datenfelder der Hauptentität aufnehmen
Set multiPageOben = Me.Controls.Add("forms.Multipage.1", "Multipage1", True)
'Die untere soll alle verlinkten Entitäten bereitstellen
'sofern mindestens eine Verlinkung konfiguriert wurde
If pageDaten.Count > 1 Then
Set multiPageTemp = Me.Controls.Add("forms.Multipage.1", "Multipage2", True)
Set multiPageUntenGeht = New clsMultiPageChangeEvent1
Set multiPageUntenGeht.MultiPageChangeGeht = multiPageTemp
Set multiPageTemp = Nothing
End If
'Obere Multipage konfigurieren
With multiPageOben
'Obere Multipage auf eine Seite reduzieren
'(wird im Standard mit 2 Seiten erzeugt)
Do
If .Pages.Count > 1 Then
.Pages.Remove "Page" & (.Pages.Count)
End If
Loop While .Pages.Count > 1
'Seite benamen
.page1.Caption = pageDaten(0)
.page1.ScrollBars = 2
.page1.KeepScrollBarsVisible = False
'Obere Multipage platzieren
.Left = 10
.Top = 10
'Wenn nur eine Entität dann ganze UF nutzen
If pageDaten.Count = 1 Then
.Width = breiteUF - 30
.Height = hoeheUF - 80
Else
'Sonst die obere Hälfte und etwas schmaler
'um für die Enlarge Buttons Platz zu haben
.Width = breiteUF - 60
.Height = hoeheUF / 2 - 50
End If
End With
'Untere Multipage konfigurieren
'sofern mindestens eine Verlinkung konfiguriert wurde
'Ab hier gibts Probleme
End Sub
Hier die nicht funktionierende Version:
Ins Klassenmodul clsMultiPageChangeEvent2:
Option Explicit
Public WithEvents MultiPageChangeFail As MSForms.MultiPage
Private Sub MultiPageChangeFail_Change()
MsgBox UserForm2.Controls("Multipage2").Value
End Sub
Code der UserForm2:
Option Explicit
Dim multiPageUntenFail As clsMultiPageChangeEvent2
Private Sub UserForm_Initialize()
'Variablen für die UserForm
Dim breiteUF As Long
Dim hoeheUF As Long
Dim multiPageOben As Control
Dim multiPageTemp As Control
'Sonstige Variablen
Dim pageDaten As Object
Dim i As Long
Dim einmal As Boolean
'Userform abhängig von der Bildschirmauflösung skalieren
Me.Width = GetSystemMetrics(SM_CXSCREEN) / 2
Me.Height = GetSystemMetrics(SM_CYSCREEN) * 0.7
'Höhe und Breite der UserForm als Berechnungsgrundlage
'für die Positionierung der Steuerelemente
breiteUF = Me.Width
hoeheUF = Me.Height
'Seiten für die Multipages feststellen
'In der Feld-Konfigurations-Tabelle sind:
' -die Reihenfolge der Pages in Spalte C festgelegt
' -die Namen der Pages in Spalte D festgelegt
Set pageDaten = CreateObject("Scripting.Dictionary")
'Manuelle Beispielfüllung
pageDaten.Add 0, "Page1"
pageDaten.Add 1, "Page2"
pageDaten.Add 2, "Page3"
'ReDim nextPlace(pageDaten.Count)
'Erzeugung von bis zu zwei Multipages übereinander
'Die obere soll nur die Datenfelder der Hauptentität aufnehmen
Set multiPageOben = Me.Controls.Add("forms.Multipage.1", "Multipage1", True)
'Die untere soll alle verlinkten Entitäten bereitstellen
'sofern mindestens eine Verlinkung konfiguriert wurde
If pageDaten.Count > 1 Then
Set multiPageTemp = Me.Controls.Add("forms.Multipage.1", "Multipage2", True)
Set multiPageUntenFail = New clsMultiPageChangeEvent2
Set multiPageUntenFail.MultiPageChangeFail = multiPageTemp
Set multiPageTemp = Nothing
End If
'Obere Multipage konfigurieren
With multiPageOben
'Obere Multipage auf eine Seite reduzieren
'(wird im Standard mit 2 Seiten erzeugt)
Do
If .Pages.Count > 1 Then
.Pages.Remove "Page" & (.Pages.Count)
End If
Loop While .Pages.Count > 1
'Seite benamen
.page1.Caption = pageDaten(0)
.page1.ScrollBars = 2
.page1.KeepScrollBarsVisible = False
'Obere Multipage platzieren
.Left = 10
.Top = 10
'Wenn nur eine Entität dann ganze UF nutzen
If pageDaten.Count = 1 Then
.Width = breiteUF - 30
.Height = hoeheUF - 80
Else
'Sonst die obere Hälfte und etwas schmaler
'um für die Enlarge Buttons Platz zu haben
.Width = breiteUF - 60
.Height = hoeheUF / 2 - 50
End If
End With
'Untere Multipage konfigurieren
'sofern mindestens eine Verlinkung konfiguriert wurde
If pageDaten.Count > 1 Then
With multiPageUntenFail
'Untere Multipage zunächst auf eine Seite reduzieren
'falls nur eine Entität verknüpft wurde
'(wird im Standard mit 2 Seiten erzeugt)
Do
If .Pages.Count > 1 Then ' 1
'Untere Multipage platzieren
.Left = 10
.Top = hoeheUF / 2 - 20
.Width = breiteUF - 60
.Height = hoeheUF / 2 - 50
'Erste Page benamen
.page1.Caption = pageDaten(1)
.page1.ScrollBars = 2
.page1.KeepScrollBarsVisible = False
'Erzeugung und Benamung der restlichen Anzahl Pages
i = 2
Do While i Also falls jemand weiß wie dieses Verhalten zustande kommt bin ich für eine Erklärung und Hilfe zur Lösung sehr dankbar.
Viele Grüße,
Zwenn