Diese Prozedur wird vom UF1 aus aufgerufen:
Private Sub CommandButton37\_Click()
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
Dim ü, i, ii, jj As Long
Dim frmCommandButton, VBComp, strName, VBFrame
Dim intRow, j, S, T, tt, myFrame, MyC
S = "SELECT \* from Tabelle" 'Hier habe ichs jetzt dramatisch vereinfacht ist aber unreleveant der SQL Part
Set rs = DB.OpenRecordset(S)
rs.MoveLast: ii = rs.RecordCount: rs.MoveFirst
jj = rs.Fields.Count
'UF.Show \*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Erstelle Grundform
Set VBComp = ThisWorkbook.VBProject.VBComponents.Add(3)
With VBComp
.Properties("Caption") = IICPLus.CBDat
.Properties("Width") = 600
.Properties("Height") = 700
.Properties("Cycle") = 0
strName = .Properties("Name")
End With
T = 50
S = "Frame1"
Set myFrame = VBComp.Designer.Controls.Add("Forms.Frame.1", S)
With myFrame
.Caption = IICPLus.CBDat
.Left = 5
.Top = T
.Height = 620
.Width = 590
.ScrollBars = 2
End With
'
T = 10
For j = 1 To jj
If rs(j - 1).Type = 12 Then tt = 70 Else tt = 20
S = "TB" & j
Set MyC = myFrame.Controls.Add("Forms.TextBox.1", S)
With MyC
.Left = 100
.Top = T
.Height = tt
.Width = 400
.MultiLine = True
End With
S = "LAB" & j
Set MyC = myFrame.Controls.Add("Forms.label.1", S)
With MyC
.Caption = rs(j - 1).Name
.Left = 10
.Top = T
.Height = tt
.Width = 70
End With
S = "CB" & j
Set MyC = myFrame.Controls.Add("Forms.commandbutton.1", S)
With MyC
.Caption = "Write!" & j
.Left = 520
.Top = T
.Height = tt
.Width = 40
End With
T = T + tt + 10
With VBComp.CodeModule
intRow = .CreateEventProc("Click", S)
.InsertLines intRow + 1, "If MsgBox(""Wollen Sie das Feld '" & rs.Fields(j - 1).Name & "' wirklich ändern?"", vbYesNo) = vbYes Then"
.InsertLines intRow + 2, "rs.Edit"
.InsertLines intRow + 3, "rs!" & rs.Fields(j - 1).Name & "= ME.Controls(""" & "TB" & j & """).Value"
.InsertLines intRow + 4, "rs.Update"
.InsertLines intRow + 5, "Application.statusbar=""Feld '" & rs.Fields(j - 1).Name & "' wurde geändert!"""
.InsertLines intRow + 6, "Else: end if"
.InsertLines intRow + 6, "End SUb"
End With
Next j
SW = jj
With VBComp.CodeModule
.InsertLines intRow, "public Sub DatenLaden"
.InsertLines intRow + 1, "Dim i As Long"
.InsertLines intRow + 2, "For i = 1 To SW"
.InsertLines intRow + 3, "If IsNull(rs(i - 1)) = False Then ME.Controls(""TB"" & i).Value = rs(i - 1)"
.InsertLines intRow + 4, "Next i"
.InsertLines intRow + 5, "End sub"
End With
S = "CB" & "X"
Set MyC = VBComp.Designer.Controls.Add("Forms.commandbutton.1", S)
With MyC
.Caption = "Laden"
.Left = 10
.Top = 5
.Height = 30
.Width = 40
End With
With VBComp.CodeModule
intRow = .CreateEventProc("Click", S)
.InsertLines intRow + 1, "Call DatenLaden"
End With
S = "CB" & "VW"
Set MyC = VBComp.Designer.Controls.Add("Forms.commandbutton.1", S)
With MyC
.Caption = "Vorwärts"
.Left = 480
.Top = 5
.Height = 30
.Width = 50
End With
With VBComp.CodeModule
intRow = .CreateEventProc("Click", S)
.InsertLines intRow + 1, "If TBNR 1 Then rs.MovePrevious"
.InsertLines intRow + 2, "TBNR = rs.AbsolutePosition + 1"
.InsertLines intRow + 3, "Call DatenLaden"
End With
S = "TB" & "NR"
Set MyC = VBComp.Designer.Controls.Add("Forms.TextBox.1", S)
With MyC
.Left = 300
.Top = 5
.Height = 15
.Width = 40
.MultiLine = True
End With
S = "Lab" & "NR"
Set MyC = VBComp.Designer.Controls.Add("Forms.TextBox.1", S)
With MyC
.Left = 340
.Top = 5
.Height = 15
.Width = 80
.MultiLine = True
End With
With VBComp.CodeModule
.InsertLines intRow, "Private Sub UserForm\_Initialize()"
.InsertLines intRow + 1, "TBNR=1"
.InsertLines intRow + 2, "Call Datenladen"
.InsertLines intRow + 3, "LabNR="" von "" & rs.RecordCount"
.InsertLines intRow + 4, "End sub"
End With
DoEvents
myFrame.ScrollHeight = T
VBA.UserForms.Add(VBComp.Name).Show
End Sub
Was 1. doof ist:
trotz
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
rollert mir beim Form-erstellen der ganze Code(VBE) übers Bild.
dann wird das Form (UF2) korrekt angezeigt und alles funktioniert auch richtig.
Wenn ich dann das UF2 schließe, ist das UF1 auch weg. Hat das was mit ShowModal zu tun? Das UF1 ist Showmodal=false un muss es auch bleiben.
[MOD] Pre-Tag eingefügt, überflüssiges Fullquote entfernt. Gruß Rainer
ich kann nicht gleichzeitig Fußball schauen und deinen Beitrag verstehen.