title image


Smiley Steuerelemente per Code erstellen und VBA Code erzeugen... (CreateControl)
Hallo Stephan,



für's Archiv nimm lieber diesen Code:

Mal ein Beispiel, wie man sich Steuerelemente per Code erstellt und wie man sich den VBA-Code dazu auch gleich mit 'stricken' kann.







'Wenn man mal viele Button benötigt ...

'Für andere Steuerelemente geht das natürlich auch

'da muß man sich den Code halt etwas anpassen....

'Ist natürlich noch arg ausbaufähig, aber wie oft benötigt man das wirklich????



'Beide Subs in ein Modul legen, die nötigen Anpassungen treffen

'danach diese Function mit F5 starten

Private Sub ButtonErstellen1()

On Error GoTo Er

  Dim i As Long, iL As Long, iT As Long, ii As Long, _

      iL2 As Long, iT2 As Long, iAnzBtn As Long, _

      iW As Long, iH As Long, iA As Long, iAnz As Long

  Dim ctl As Control, s As String, frm As Form, bolVertical As Boolean

  

  s = "DeinFormName"  'Dein Formular



  iAnzBtn = 50        'Anzahl der Button gesamt

  iAnz = 10           'neue Reihe nach wieviel Button

  bolVertical = False 'Reihe senkrecht erstellen

  

  'Die Button:

  iW = 1200           'Breite

  iH = 350            'Höhe



  iL = 100            'Startwert Left

  iT = 100            'Startwert Top

  iA = 50             'Abstand der Button

  

  'Los geht's:

  ii = 1

  iL2 = iL

  iT2 = iT

  DoCmd.OpenForm s, acDesign

  Set frm = Forms(s)

  For i = 1 To iAnzBtn

      Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , iL2, iT2, iW, iH)

      ctl.Name = "DeinName" & i

      ctl.Properties("Caption") = "DeinText" & i

      'Hier das Ereignis 'Beim Klicken' definieren:

      ctl.Properties("OnClick") = "[Event Procedure]"

      'Die Sub schreiben:

      sCreateSubs frm.Name, ctl.Name

    'Austrichtung definieren:

    If i Mod iAnz = 0 Then

      If bolVertical Then

        iL2 = iL + (iW + iA) * ii

        iT2 = iT

      Else

        iL2 = iL

        iT2 = iT + (iH + iA) * ii

      End If

      ii = ii + 1

    Else

      If bolVertical Then

        iT2 = iT2 + iH + iA

      Else

        iL2 = iL2 + iW + iA

      End If

    End If

  Next i

  DoCmd.OpenForm s, acNormal



Ex:

  On Error Resume Next

  Set ctl = Nothing

  Set frm = Nothing

  Exit Sub

Er:

  Dim strErr As String

  strErr = "Fehlermeldung/Information..." & vbCrLf

  strErr = strErr & "FehlerNummer: " & Err.Number & vbCrLf

  strErr = strErr & "Beschreibung: " & Err.Description

  MsgBox strErr, vbCritical + vbOKOnly, "Sub: ButtonErstellen"

  Resume Ex

  Resume

End Sub

'__________________________________________________________________________________________



Private Sub sCreateSubs(strModule As String, strCtlName As String)

On Error GoTo Er

  Dim mdl As Module, s As String

  

  'Die Sub deklarieren

  s = "Private Sub " & strCtlName & "_Click()" & vbCrLf

  s = s & "On Error GoTo Er" & vbCrLf

  'Die eigentlichen Befehle in der Sub:

  s = s & vbCrLf

  s = s & "  'Dein Code, zum Beispiel:" & vbCrLf

  s = s & "  MsgBox ""Sie klickten auf das Steuerelement: "" & me!" & strCtlName & ".Name"

  s = s & ", vbInformation, ""SteuerelementName""" & vbCrLf

  s = s & vbCrLf

  'Der Ausgang:

  s = s & "Ex:" & vbCrLf

  s = s & "  On Error Resume Next" & vbCrLf

  s = s & "  Exit Sub" & vbCrLf

  'Der Errorhandler:

  s = s & "Er:" & vbCrLf

  s = s & "  Dim strErr As String" & vbCrLf

  s = s & "  strErr = ""Fehlermeldung/Information..."" & vbCrLf" & vbCrLf

  s = s & "  strErr = strErr & ""FehlerNummer: "" & Err.Number & vbCrLf" & vbCrLf

  s = s & "  strErr = strErr & ""Beschreibung: "" & Err.Description" & vbCrLf

  s = s & "  MsgBox strErr, vbCritical + vbOKOnly, ""Sub: " & strCtlName

  s = s & "_Click im VBA Dokument Form_" & strModule & """" & vbCrLf

  s = s & "  Resume Ex" & vbCrLf

  'für's debuggen:

  s = s & "  Resume" & vbCrLf

  'und Ende der Sub:

  s = s & "End Sub" & vbCrLf

    

  Set mdl = Forms(strModule).Module

  'die Sub schreiben:

  mdl.InsertText s



Ex:

  On Error Resume Next

  Set mdl = Nothing

  Exit Sub

Er:

  If Err.Number = 7961 Then

      DoCmd.OpenModule strModule

      Resume

  Else

    Dim strErr As String

    strErr = "Fehlermeldung/Information..." & vbCrLf

    strErr = strErr & "FehlerNummer: " & Err.Number & vbCrLf

    strErr = strErr & "Beschreibung: " & Err.Description

    MsgBox strErr, vbCritical + vbOKOnly, "Sub: sCreateSubs"

    Resume Ex

  End If

  Resume

End Sub











Gruß Carsten


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: