Tipp 0075 Excel-VBE - UserForm inkl. Code erstellen
Autor/Einsender:
Datum:
  Angie
03.06.2001
Entwicklungsumgebung:   VB 5
Eine sehr interessante Variante der Automatisierung von Excel ist die VBE-Programmierung. In diesem Beispiel wird aufgezeigt, wie in einer neuen Arbeitsmappe eine UserForm inkl. Code erstellt wird und diese auch über ein per Code hinzugefügtes Modul aufgerufen werden kann. Die so dynamisch erstellte UserForm kann sowohl im Excel-VB-Editor weiter bearbeitet werden als auch mit der Arbeitsmappe abgespeichert werden.
 
Option Explicit

Dim xlAppl As Object
Dim xlApplLiefNicht As Boolean
Dim xlWB As Object
Dim xlWBName As String

Dim xlUserForm As Object
Dim xlUserFormName As String

Private Sub Form_Initialize()

  On Error Resume Next
  Set xlAppl = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then xlApplLiefNicht = True
  Err.Clear

End Sub

Private Sub cmdxlUserFormVBE_Click()

  Select Case cmdxlUserFormVBE.Caption
    Case Is = "&UserForm im VBE erstellen"
      Call xlUserFormDesign_Start
      cmdxlUserFormVBE.Caption = "&UserForm im VBE anzeigen"
      Me.Label2.Caption = "Die in der Excel-Arbeitsmappe '" & _
            xlWBName & "' neuerstellte UserForm kann im " & _
            "Excel-VB-Editor angezeigt werden !"

    Case Is = "&UserForm im VBE anzeigen"
      Call xlUserFormAnzeigen
      cmdxlUserFormVBE.Caption = "&UserForm im VBE erstellen"
      cmdxlUserFormVBE.Enabled = False
      Me.Label2.Caption = "Mit diesem Beispiel wird in Excel " & _
            "eine neue Arbeitsmappe geöffnet und im Excel-VB-" & _
            "Editor eine UserForm inkl. Code hinzugefügt."
  End Select

End Sub

Sub xlUserFormDesign_Start()

  On Error GoTo errorMsgExcel
  If xlAppl Is Nothing Then _
    Set xlAppl = CreateObject("Excel.Application")

  On Error GoTo errorMsgXLMappe
  Set xlWB = xlAppl.Workbooks.Add
  On Error GoTo 0

  xlWBName = xlAppl.ActiveWorkbook.Name

  Call xlUserFormDesign

  xlAppl.Application.Visible = True
  xlAppl.Run "UserFormAnzeigen"

  Exit Sub

errorMsgExcel:
  MsgBox "Konnte keine Verbindung zu Excel herstellen !", _
         16, "Problem"
  Exit Sub

errorMsgXLMappe:
  MsgBox "Es traten Probleme bei der Erstellung" & _
         " einer neuen Arbeitsmappe auf !", 16, "Problem"
    If xlApplLiefNicht Then xlAppl.Application.Quit
    Set xlAppl = Nothing
  Exit Sub

End Sub

Sub xlUserFormDesign()
  Dim xlLabelMsg As Object
  Dim xlCmdOK As Object
  Dim xlModul As Object

  Dim strCode As String
  Dim leerZ As String

  leerZ = "  "

  Set xlUserForm = _
     xlWB.VBProject.VBComponents.Add(vbext_ct_MSForm)
  xlUserFormName = xlUserForm.Name

  Set xlLabelMsg = xlUserForm.Designer.Controls.Add _
      ("Forms.Label.1", , True)
  With xlLabelMsg
    .Left = 9
    .Top = 12
    .Height = 20
    .Width = 180
    .Caption = "Ich bin die neuerstellte UserForm in der " & _
               "Excel-Arbeitsmappe '" & xlWBName & "'"
  End With

  Set xlCmdOK = xlUserForm.Designer.Controls.Add _
      ("Forms.CommandButton.1", "cmdOK", True)
  With xlCmdOK
    .Left = 129
    .Top = 42
    .Height = 18
    .Width = 60
    .Caption = "OK"
    .Default = True
  End With

  With xlUserForm.CodeModule
    .InsertLines 2, ""
    .InsertLines 3, "Private Sub UserForm_Initialize()"
    .InsertLines 4, leerZ & "Me.Height = 90"
    .InsertLines 5, leerZ & "Me.Width = 203"
    .InsertLines 6, leerZ & "Me.Caption = " & _
                            """eue UserForm in Excel"""
    .InsertLines 7, leerZ & "Me.StartUpPosition = 1"
    .InsertLines 8, leerZ & "Me.cmdOK.Accelerator = ""O"""
    .InsertLines 9, leerZ & "Me.cmdOK.Cancel = True"
    .InsertLines 10, "End Sub"

    .InsertLines 11, ""
    .InsertLines 12, "Private Sub cmdOK_Click()"
    .InsertLines 13, leerZ & "Unload Me"
    .InsertLines 14, "End Sub"
  End With

  Set xlModul = xlWB.VBProject.VBComponents.Add(vbext_ct_StdModule)
  strCode = _
     "Sub UserFormAnzeigen()" & vbCr & _
        leerZ & xlUserFormName & ".Show " & vbCr & _
     "End Sub"
  xlModul.CodeModule.AddFromString strCode

  xlWB.Saved = True

  Set xlModul = Nothing
  Set xlLabelMsg = Nothing
  Set xlCmdOK = Nothing

End Sub

Sub xlUserFormAnzeigen()

  xlAppl.Application.VBE.MainWindow.SetFocus
  xlWB.VBProject.VBComponents(xlUserFormName).Activate
  xlAppl.Application.VBE.MainWindow.Visible = True

End Sub

Private Sub cmdBeenden_Click()
  Dim wb As Excel.Workbook

  On Error Resume Next
  If Not xlAppl Is Nothing Then
    If xlAppl.Workbooks.Count > 0 Then
      With xlAppl
        For Each wb In xlAppl.Workbooks
          If LCase(wb.Name) = LCase(xlWBName) Then
            wb.Close SaveChanges:=False
          End If
        Next
      End With
    End If

    Set xlUserForm = Nothing
    Set xlWB = Nothing

    If xlApplLiefNicht Then xlAppl.Application.Quit
    Set xlAppl = Nothing
  End If

  Unload Me
  End

End Sub
 
Hinweis
Im Download-Beispiel ist der Quellcode kommentiert, es wurde hier jedoch aus Gründen der Übersichtlichkeit darauf verzichtet.
Um diesen Tipp ausführen zu können, muss Excel installiert sein und zur Entwurfszeit die Microsoft Excel x.0 Object Library in das Projekt eingebunden werden. Für die VBE-Programmierung ist zusätzlich das Einbinden der Objektbibliothek Visual Basic 6.0 Extensibility notwendig.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,8 kB) Downloads bisher: [ 3397 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 30. August 2011