Zur Laufzeit hinzugefügte Userform öffnet VBA-Editor

12/10/2009 - 14:47 von Andreas Killer | Report spam
Juhu. :-))

Mein Hauptanliegen ist es eine Userform zu erstellen mit der der User
schnell eine vordefinierte Lösung wàhlen kann.

Da kam mir die Idee das man eine MsgBox mit konfigurierbaren Button's
bràuchte, weil mit Ja/Nein/Abbruch der MsgBox ist mir nicht gedient.

Die Button's der MsgBox lassen sich ja IMHO nicht àndern, bzw.
Userdefined hinzufügen, also hab ich gegoogled, gefummelt und es auch
hinbekommen zur Laufzeit eine Userform hinzuzufügen, Button's zu
erzeugen, Event-Routinen in den Code zu etablieren, usw.

Làuft, totschick, tja bis auf die Feinheit das meine ButtonBox den VBA-
Editor öffnet!???!
Wieso, weshalb, was kann man dagegen tun?
Das VBProject zu sperren möchte ich nicht.

Sub Test()
Dim I As Integer
I = ButtonBox("Welche Parameter àndern?", "Anfahrbohrung", _
"Anfahrr&adius", "Anfahrw&inkel", "b&eide")
End Sub

Dies ist der Aufruf, der Code der ButtonBox muss in ein normales
Modul, das ganze betrifft Excel 2000 (und höher?)

Andreas.

'Version 1.0
Option Explicit
Option Private Module

Public ButtonBoxResult As Integer

Public Function ButtonBox(Prompt As String, Title As String, _
ParamArray Buttons()) As Integer
'Erstellt eine Userform mit Buttons, gibt den gedrückten Button _
zurück (1 bis...), 0 = Abbruch
Const TitleHeight = 20
Const PromptHeight = 11
Const Rand = 6, Schatten = 3

'Dim VBComp As VBComponent
Dim VBComp As Object
Const vbext_ct_MSForm = 3

Dim UFBreite As Long, UFHöhe As Long
Dim VBControl As Control, PromptControl As Control, _
AbortControl As Control
Dim I As Integer, j As Integer, S As String
Dim CpY As Long, CpX As Long, CodePos As Long

'Userform erzeugen
Set VBComp = ThisWorkbook.VBProject.VBComponents.Add( _
vbext_ct_MSForm)

'Prompt hinzufügen
Set PromptControl = VBComp.Designer.Controls.Add("Forms.Label" & _
".1", "Prompt")
With PromptControl
.Left = Rand
.Top = Rand
.Width = 1000 'Sicherstellen das er einzeilig ist
.Height = PromptHeight
.Caption = Prompt
.AutoSize = True
.TextAlign = fmTextAlignCenter
UFBreite = WorksheetFunction.Max(UFBreite, .Left + .Width + _
Rand + Schatten)
CpY = .Top + .Height
End With

'User-Buttons hinzufügen
For I = LBound(Buttons) To UBound(Buttons)
S = "CommandButton" & I
Set VBControl = VBComp.Designer.Controls.Add("Forms" & _
".CommandButton.1", S)
With VBControl
.Left = CpX + Rand
.Top = CpY + Rand
.Caption = Replace(Buttons(I), "&", "")
j = InStr(Buttons(I), "&")
If j > 1 Then .Accelerator = Mid(Buttons(I), j - 1, 1)
.AutoSize = True
CpX = .Left + .Width
End With

'Ereignis-Code hinzufügen
With VBComp.CodeModule
CodePos = .CreateEventProc("Click", S)
S = "ButtonBoxResult = " & I + 1 & vbCrLf & "Unload Me"
.InsertLines CodePos + 1, S
End With
Next

'Nàchste Zeile vom letzten Control holen
With VBControl
CpY = .Top + .Height
UFBreite = WorksheetFunction.Max(UFBreite, CpX + Rand + _
Schatten)
End With

'Abbruch-Button hinzufügen
S = "A&bbruch"
Set AbortControl = VBComp.Designer.Controls.Add("Forms" & _
".CommandButton.1", Replace(S, "&", ""))
With AbortControl
j = InStr(S, "&")
If j > 1 Then .Accelerator = Mid(S, j - 1, 1)
.Left = Rand
.Top = CpY + Rand
.Caption = Replace(S, "&", "")
.AutoSize = True
.Cancel = True
UFHöhe = .Top + .Height + Rand
UFBreite = WorksheetFunction.Max(UFBreite, .Width + Rand + _
Schatten)
End With
'Ereignis-Code hinzufügen
With VBComp.CodeModule
CodePos = .CreateEventProc("Click", Replace(S, "&", ""))
S = "ButtonBoxResult = 0" & vbCrLf & "Unload Me"
.InsertLines CodePos + 1, S
End With

'Prompt und Abbruch auf Breite der UF dimensionieren
With PromptControl
.AutoSize = False
.Width = UFBreite - 2 * Rand - Schatten
End With
With AbortControl
.AutoSize = False
.Width = UFBreite - 2 * Rand - Schatten
End With

'UF dimensionieren
With VBComp
.Properties("Width") = UFBreite
.Properties("Height") = UFHöhe + TitleHeight
.Properties("Caption") = Title
'Codename holen
S = .Properties("Name")
End With

'UF hinzufügen und aufrufen
VBA.UserForms.Add(S).Show
'Ergebnis zurückgeben
ButtonBox = ButtonBoxResult
'UF entfernen
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Function
 

Lesen sie die antworten

#1 Alexander Wolff
13/10/2009 - 13:23 | Warnen spam
Als <news:
ließ
Andreas Killer verlautbaren, evtl. nachfolgend zitiert:

Ich ahne, was Du willst. Ich habe aber alles (samt Sub Test) in ein normales
Modul kopiert - der Code stoppt schon früh mit einer Fehlermeldung. Gibt es
weitere Voraussetzungen, die man bei Dir nicht lesen konnte?
Moin+Gruss Alexander - MVP for MS Excel - www.xxcl.de - mso2000sp3 --7-2

Ähnliche fragen