title image


Smiley Re: Es funktioniert und...doch wieder nicht :-(
Hallo Heidrun,um alle Userforms auszulesen, habe ich den Code dahingehend abbgeaendert, dass diese mit ihrem jeweiligen ProjektIndexVBComponent-NamenVBComponent-Indexin ein globales Array geschrieben werden. Soweit so gut.Wenn man dann versucht ueber eine Schleife alle Userforms des Arrays anzuzeigen,gibt's einen Fehler Nr. 424 (leider ohne weitere Erklaerung).Ich befuerchte das man Userforms aus anderen Projekten nicht laden oder anzeigen lassen kann.Um alle Userforms des Aktiven Projektes angezeigt zu bekommen, habe ich leider auch keine passende Loesung.Die Methode mit VBA.UserForms.Add(objForm.Name).Show scheint auch nur irgend wie eine Kruecke zu sein, um genau eine Userform zu laden.Die Schleife wird danach nicht weiter abgearbeitet, weil mit der Anzeige der Userform das Makro automatisch abgebrochen wird.Trotzdem der Code, vielleicht findest Du damit ja eine andere Loesung?xxxxxxxxxxxxxxxxxxxxxxxDim arrMyVBComps() Sub ShowForm() Dim FormID As String FormID = "UserForm1" Call GetUserForms CallForm (FormID)End Sub Function GetUserForms() Dim intI As Integer Dim lngI As Long Dim lngK As Long Dim lngL As Long Dim lngM As Long Dim strRoutine As String Dim varVBType As Variant lngM = Application.VBE.VBProjects.Count ReDim arrMyVBComps(2, 0) For lngL = 1 To lngM Step 1 On Error GoTo ErrorHandler lngK = Application.VBE.VBProjects(lngL).VBComponents.Count For lngI = 1 To lngK Step 1 ' VBComponent-Types: ' Modules = 1 ' Classmodules = 2 ' UserForms = 3 ' Worksheets = 100 varVBType = Application.VBE.VBProjects(lngL).VBComponents(lngI).Type If varVBType = 3 Then 'Userforms ReDim Preserve arrMyVBComps(2, intI) 'VBProject-index arrMyVBComps(0, intI) = lngL 'VBComponent-Name arrMyVBComps(1, intI) = Application.VBE.VBProjects(lngL).VBComponents.Item(lngI).Name 'VBComponent-index arrMyVBComps(2, intI) = lngI intI = intI + 1 End If Next lngI Next lngL Exit FunctionErrorHandler:' Project is protected, enumeration not possible. If Err.Number = 50289 Then varVBType = 0 Resume Next Else strRoutine = "Function GetUserForms ()" MsgBox "Error # " & CStr(Err.Number) & vbCrLf _ & "was generated while executing:" & vbCrLf & vbCrLf _ & strRoutine & vbCrLf & vbCrLf _ & "Reported by: " & vbTab & Err.Source & vbCrLf _ & "Description: " & vbTab & Err.Description, vbCritical End IfEnd Function Sub CallForm(ByVal MyFormName) Dim intI As Integer Dim objForm As Object For intI = LBound(arrMyVBComps) To UBound(arrMyVBComps) + 1 Step 1 If arrMyVBComps(1, intI) = MyFormName Then Set objForm = Application.VBE.VBProjects(arrMyVBComps(0, intI)).VBComponents.Item(arrMyVBComps(2, intI)) VBA.UserForms.Add(objForm.Name).Show End If Next intI Set objForm = NothingEnd SubxxxxxxxxxxxxxxxxxxxxxxxSorry, und viele GruesseNorbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: