Office: (Office 2010) Excel VBA Maske erstellen

Helfe beim Thema Excel VBA Maske erstellen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo liebe Community, ich bräuchte etwas Hilfe bei der Erstellung einer VBA Eingabe Maske. Diese dient dazu Fehler im Betrieb zu dokumentieren.... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Noahreza, 25. Februar 2018.

  1. Noahreza hat Ahnung

    Excel VBA Maske erstellen


    Hallo liebe Community,

    ich bräuchte etwas Hilfe bei der Erstellung einer VBA Eingabe Maske.
    Diese dient dazu Fehler im Betrieb zu dokumentieren. Dazu habe ich eine Maske erstellt, in denen die
    Eingaben erfolgen sollen.
    Außerdem soll es für einen bestimmten Nutzerkreis eine Art Filtermöglichkeit geben, um die eingegebenen Daten
    anzuzeigen und ggfs. zu filtern.
    Ich habe dazu schon einige VBA Codes gefunden und versucht sie meinen Bedürfnissen anzupassen, jedoch ohne Erfolg.
    Vielleicht kennt sich ja jemand gut genug aus...
    Ich habe die screenshots mal angefügt und auch die Codes.
    Würde mich über Hilfe sehr freuen.



    Excel VBA Maske erstellen UserForm1.jpg Excel VBA Maske erstellen UserForm2.jpg
    Code:
    Option Explicit
    Option Compare Text
    
    Private Const iCONST_ANZAHL_EINGABEFELDER As Integer = 10
    
    Private Const lCONST_STARTZEILENNUMMER_DER_TABELLE As Long = 2
    
    Private Sub CommandButton1_Click()
          Call EINTRAG_ANLEGEN
    End Sub
    Private Sub CommandButton2_Click()
          Call EINTRAG_LOESCHEN
    End Sub
    
    Private Sub CommandButton3_Click()
          Call EINTRAG_SPEICHERN
    End Sub
    
    Private Sub CommandButton4_Click()
          Unload Me
    End Sub
    
    Private Sub ListBox1_Click()
          Call EINTRAG_LADEN_UND_ANZEIGEN
    End Sub
    
    
    Private Sub UserForm_Activate()
          If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 1
        
    End Sub
    
    
    Private Sub UserForm_Initialize()
          Call LISTE_LADEN_UND_INITIALISIEREN
    End Sub
    ' ************************************************************************************************
    ' VERARBEITUNGSROUTINEN
    ' ************************************************************************************************
    
    ´Private Sub LISTE_LADEN_UND_INITIALISIEREN()
        Dim lZeile As Long
        Dim lZeileMaximum As Long
        Dim i As Integer
        
          For i = 1 To iCONST_ANZAHL_EINGABEFELDER
              Me.Controls("TextBox" & i) = ""
          Next i
    
          ListBox1.Clear
          ListBox1.ColumnCount = 10
          
         ListBox1.ColumnWidths = "0;;;;;;;;;"
          
          
           lZeileMaximum = Tabelle1.UsedRange.Rows.Count
          
          For lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE To lZeileMaximum
              
              If IST_ZEILE_LEER(lZeile) = False Then
                  
              
                  ListBox1.AddItem lZeile
       ListBox1.List(ListBox1.ListCount - 1, 1) = CStr(Tabelle1.Cells(lZeile, 1).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 2) = CStr(Tabelle1.Cells(lZeile, 2).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 3) = CStr(Tabelle1.Cells(lZeile, 3).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 4) = CStr(Tabelle1.Cells(lZeile, 4).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 5) = CStr(Tabelle1.Cells(lZeile, 5).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 6) = CStr(Tabelle1.Cells(lZeile, 6).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 7) = CStr(Tabelle1.Cells(lZeile, 7).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 8) = CStr(Tabelle1.Cells(lZeile, 8).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 9) = CStr(Tabelle1.Cells(lZeile, 9).Text)
                  ListBox1.List(ListBox1.ListCount - 1, 10) = CStr(Tabelle1.Cells(lZeile, 10).Text)
              End If
    Next lZeile
          
    End Sub
    
    Private Sub EINTRAG_LADEN_UND_ANZEIGEN()
        Dim lZeile As Long
        Dim i As Integer
          
        For i = 1 To iCONST_ANZAHL_EINGABEFELDER
              Me.Controls("TextBox" & i) = ""
          Next i
           If ListBox1.ListIndex >= 0 Then
                 
              lZeile = ListBox1.List(ListBox1.ListIndex, 0)
              
              For i = 1 To iCONST_ANZAHL_EINGABEFELDER
                  Me.Controls("TextBox" & i) = CStr(Tabelle1.Cells(lZeile, i).Text)
              Next i
                  
          End If
          
    End Sub
    
    Private Sub EINTRAG_SPEICHERN()
       Dim lZeile As Long
       Dim i As Integer
       
          If ListBox1.ListIndex = -1 Then Exit Sub
         
          lZeile = ListBox1.List(ListBox1.ListIndex, 0)
          
          For i = 1 To iCONST_ANZAHL_EINGABEFELDER
              Tabelle1.Cells(lZeile, i) = Me.Controls("TextBox" & i)
          Next i
          ListBox1.List(ListBox1.ListIndex, 0) = TextBox1
          ListBox1.List(ListBox1.ListIndex, 1) = TextBox2
          ListBox1.List(ListBox1.ListIndex, 2) = TextBox3
          ListBox1.List(ListBox1.ListIndex, 3) = TextBox4
          ListBox1.List(ListBox1.ListIndex, 4) = TextBox5
          ListBox1.List(ListBox1.ListIndex, 5) = TextBox6
          ListBox1.List(ListBox1.ListIndex, 6) = TextBox7
          ListBox1.List(ListBox1.ListIndex, 7) = TextBox8
          ListBox1.List(ListBox1.ListIndex, 8) = TextBox9
          ListBox1.List(ListBox1.ListIndex, 9) = TextBox10
          
        End Sub
    
    Private Sub EINTRAG_LOESCHEN()
       Dim lZeile As Long
        
    If ListBox1.ListIndex = -1 Then Exit Sub
        
    If MsgBox("Sie möchten den markierten Datensatz wirklich löschen?", _
                    vbQuestion + vbYesNo, "Sicherheitsabfrage!") = vbYes Then
        
    lZeile = ListBox1.List(ListBox1.ListIndex, 0)
              
              Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
              
              ListBox1.RemoveItem ListBox1.ListIndex
          
          End If
         End Sub
    Private Sub EINTRAG_ANLEGEN()
       Dim lZeile As Long
          
          lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE
          
          Do While IST_ZEILE_LEER(lZeile) = False
              lZeile = lZeile + 1
          Loop
          Tabelle1.Cells(lZeile, 1) = CStr("")
           ListBox1.AddItem lZeile
          ListBox1.List(ListBox1.ListCount - 1, 1) = CStr("" & lZeile)
          ListBox1.List(ListBox1.ListCount - 1, 2) = CStr("" & lZeile)
          ListBox1.List(ListBox1.ListCount - 1, 3) = CStr("" & lZeile)
          ListBox1.List(ListBox1.ListCount - 1, 4) = CStr("" & lZeile)
          ListBox1.List(ListBox1.ListCount - 1, 5) = CStr("" & lZeile)
          ListBox1.List(ListBox1.ListCount - 1, 3) = ""
          ListBox1.List(ListBox1.ListCount - 1, 4) = ""
          ListBox1.List(ListBox1.ListCount - 1, 5) = ""
          ListBox1.List(ListBox1.ListCount - 1, 6) = ""
          ListBox1.List(ListBox1.ListCount - 1, 7) = ""
          ListBox1.List(ListBox1.ListCount - 1, 8) = ""
          ListBox1.List(ListBox1.ListCount - 1, 9) = ""
       
          ListBox1.ListIndex = ListBox1.ListCount - 1
         TextBox1.SetFocus
          TextBox1.SelStart = 0
          TextBox1.SelLength = Len(TextBox1)
          
    End Sub
    Private Function IST_ZEILE_LEER(ByVal lZeile As Long) As Boolean
        Dim i As Long
        Dim sTemp As String
        
    sTemp = ""
       
          For i = 1 To iCONST_ANZAHL_EINGABEFELDER
              sTemp = sTemp & Trim(CStr(Tabelle1.Cells(lZeile, i).Text))
          Next i
          
    If Trim(sTemp) = "" Then
             
              IST_ZEILE_LEER = True
          Else
            
              IST_ZEILE_LEER = False
          End If
          
    End Function
    
    
     
    Noahreza, 25. Februar 2018
    #1
  2. Exl121150 Erfahrener User
    Hallo,

    nachfolgend habe ich dir den Code modifiziert und ich hoffe, dass er jetzt besser läuft.
    Die Hauptprobleme lagen darin:
    1) In der ListBox beginnen sämtliche Indizes bei 0 (und nicht bei 1).
    2) In verdoppelten ListBox-Methodenaufrufen (ListBox1.List(ListBox1.ListIndex, 0)) statt einfach: ListBox1.ListIndex
    3) Bei ListBox1.AddItem kann man sich das Leben vereinfachen, wenn man keinen Index angibt (=Anfügen am Ende).
    4) Im Excel-Arbeitsblatt beginnt die Zeilenzählung jedoch bei 1 und darüber hinaus gibt es einen Zeilenoffset (=2).

    Code:
    Option Explicit
    Option Compare Text
    
    Private Const iCONST_ANZAHL_EINGABEFELDER As Integer = 10
    Private Const lCONST_STARTZEILENNUMMER_DER_TABELLE As Long = 2
    
    Private Sub CommandButton1_Click()
          Call EINTRAG_ANLEGEN
    End Sub
    Private Sub CommandButton2_Click()
          Call EINTRAG_LOESCHEN
    End Sub
    
    Private Sub CommandButton3_Click()
          Call EINTRAG_SPEICHERN
    End Sub
    
    Private Sub CommandButton4_Click()
          Unload Me
    End Sub
    
    Private Sub ListBox1_Click()
          Call EINTRAG_LADEN_UND_ANZEIGEN
    End Sub
    
    Private Sub UserForm_Activate()
          If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
    End Sub
    
    Private Sub UserForm_Initialize()
          Call LISTE_LADEN_UND_INITIALISIEREN
    End Sub
    
    ' ************************************************************************************************
    ' VERARBEITUNGSROUTINEN
    ' ************************************************************************************************
    
    Private Sub LISTE_LADEN_UND_INITIALISIEREN()   'UserForm_Initialize()
        Dim lZeile As Long
        Dim lZeileMaximum As Long
        Dim i As Integer
        
        For i = 1 To iCONST_ANZAHL_EINGABEFELDER
            Me.Controls("TextBox" & i) = ""
        Next i
        
        With ListBox1
          .Clear
          .ColumnCount = 10
          .ColumnWidths = "0;;;;;;;;;"
        
          lZeileMaximum = Tabelle1.UsedRange.Rows.Count
          
          For lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE To lZeileMaximum
              If IST_ZEILE_LEER(lZeile) = False Then
                .AddItem
                .List(.ListCount - 1, 0) = CStr(Tabelle1.Cells(lZeile, 1).Text)
                .List(.ListCount - 1, 1) = CStr(Tabelle1.Cells(lZeile, 2).Text)
                .List(.ListCount - 1, 2) = CStr(Tabelle1.Cells(lZeile, 3).Text)
                .List(.ListCount - 1, 3) = CStr(Tabelle1.Cells(lZeile, 4).Text)
                .List(.ListCount - 1, 4) = CStr(Tabelle1.Cells(lZeile, 5).Text)
                .List(.ListCount - 1, 5) = CStr(Tabelle1.Cells(lZeile, 6).Text)
                .List(.ListCount - 1, 6) = CStr(Tabelle1.Cells(lZeile, 7).Text)
                .List(.ListCount - 1, 7) = CStr(Tabelle1.Cells(lZeile, 8).Text)
                .List(.ListCount - 1, 8) = CStr(Tabelle1.Cells(lZeile, 9).Text)
                .List(.ListCount - 1, 9) = CStr(Tabelle1.Cells(lZeile, 10).Text)
              End If
          Next lZeile
          
        End With   'ListBox1
          
    End Sub
    
    Private Sub EINTRAG_LADEN_UND_ANZEIGEN()   'ListBox1_Click()
        Dim lZeile As Long
        Dim i As Integer
          
        For i = 1 To iCONST_ANZAHL_EINGABEFELDER
           Me.Controls("TextBox" & i) = ""
        Next i
        
        With ListBox1
           If .ListIndex >= 0 Then
        
              lZeile = .ListIndex + lCONST_STARTZEILENNUMMER_DER_TABELLE
              
              For i = 1 To iCONST_ANZAHL_EINGABEFELDER
                  Me.Controls("TextBox" & i) = CStr(Tabelle1.Cells(lZeile, i).Text)
              Next i
          
           End If
        End With  'ListBox1
    End Sub
    
    Private Sub EINTRAG_SPEICHERN()   'CommandButton3_Click()
       Dim lZeile As Long
       Dim i As Integer
       
       With ListBox1
           If .ListIndex = -1 Then Exit Sub
          
           lZeile = .ListIndex + lCONST_STARTZEILENNUMMER_DER_TABELLE
           
           For i = 1 To iCONST_ANZAHL_EINGABEFELDER
               Tabelle1.Cells(lZeile, i) = Me.Controls("TextBox" & i)
           Next i
          
          .List(.ListIndex, 0) = TextBox1
          .List(.ListIndex, 1) = TextBox2
          .List(.ListIndex, 2) = TextBox3
          .List(.ListIndex, 3) = TextBox4
          .List(.ListIndex, 4) = TextBox5
          .List(.ListIndex, 5) = TextBox6
          .List(.ListIndex, 6) = TextBox7
          .List(.ListIndex, 7) = TextBox8
          .List(.ListIndex, 8) = TextBox9
          .List(.ListIndex, 9) = TextBox10
       
       End With 'ListBox1
    End Sub
    
    Private Sub EINTRAG_LOESCHEN()           'CommandButton2_Click()
      Dim lZeile As Long
        
      With ListBox1
          If .ListIndex = -1 Then Exit Sub
            
          If MsgBox("Sie möchten den markierten Datensatz wirklich löschen?", _
                        vbQuestion + vbYesNo, "Sicherheitsabfrage!") = vbYes Then
                        
              lZeile = .ListIndex + lCONST_STARTZEILENNUMMER_DER_TABELLE
              Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
              .RemoveItem .ListIndex
              
          End If
      End With
      
    End Sub
       
    Private Sub EINTRAG_ANLEGEN()            'CommandButton1_Click()
       Dim lZeile As Long
          
       lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE  '=Zeilenoffset Excel-Tabelle1
       
       Do While IST_ZEILE_LEER(lZeile) = False
           lZeile = lZeile + 1
       Loop
       'lZeile = Nr. der 1.Leerzeile in der Excel-Tabelle1
       Tabelle1.Cells(lZeile, 1) = CStr("")
       
       With ListBox1
          .AddItem   'Zeile anfügen in ListBox1
          .List(.ListCount - 1, 0) = CStr("" & lZeile)
          .List(.ListCount - 1, 1) = CStr("" & lZeile)
          .List(.ListCount - 1, 2) = CStr("" & lZeile)
          .List(.ListCount - 1, 3) = CStr("" & lZeile)
          .List(.ListCount - 1, 4) = CStr("" & lZeile)
          .List(.ListCount - 1, 5) = ""
          .List(.ListCount - 1, 6) = ""
          .List(.ListCount - 1, 7) = ""
          .List(.ListCount - 1, 8) = ""
          .List(.ListCount - 1, 9) = ""
      
          .ListIndex = .ListCount - 1
       End With
       
       With TextBox1
          .SetFocus
          .SelStart = 0
          .SelLength = Len(TextBox1)
       End With
    End Sub
    
    Private Function IST_ZEILE_LEER(ByVal lZeile As Long) As Boolean
        Dim i As Long
        Dim sTemp As String
        
        sTemp = ""
       
        For i = 1 To iCONST_ANZAHL_EINGABEFELDER
             sTemp = sTemp & Trim(CStr(Tabelle1.Cells(lZeile, i).Text))
        Next i
          
        IST_ZEILE_LEER = Len(Trim(sTemp)) = 0
        
    End Function
    
    
     
    Exl121150, 26. Februar 2018
    #2
  3. Noahreza hat Ahnung
    Hallo Anton,

    das ist sensationell....das meiste ist zwar böhmische Dörfer für mich, aber ich denke du hast es schon gaaaaanz weit nach vorne gebracht.
    Ich würde noch gerne die Maske etwas begrenzen, in dem ich die Eingabefelder z.B. durch einige Drop-Down-Menüs begrenze.
    Außerdem würde ich die Daten aus "ästhetischen Gründen lieber irgendwo im Verborgenen "ablegen" wollen, so das nicht alle Daten zu sehen sind, sobald man die Datei öffnet, sondern nur die in dem Anzeigefeld der Maske. (siehe screenshot)

    Der 2. Button mit der Filtermaske soll ebenso reagieren, d.h. das die Daten nur im Anzeigefeld angezeigt werden und man bei einer Eingabe in der Maske nur die entsprechenden Felder angezeigt bekommt. Hier dann auch die entsprechenden Dropdowns aus der Eingabemaske.
    Bin mir gerade nur nicht sicher wie das mit der Filterung klappen soll....
    Wenn ich z.B. die Daten von einem bestimmten Tag gezeigt haben will, kann ich mir das noch vorstellen, aber was wenn ich alle ab dann sehen will???

    Fragen über Fragen....

    LG Noahreza

    Screenshot: Excel VBA Maske erstellen 2018-03-01 10_18_03-Microsoft Excel - 0002.jpg
     
    Zuletzt bearbeitet: 1. März 2018
    Noahreza, 1. März 2018
    #3
Thema:

Excel VBA Maske erstellen

Die Seite wird geladen...
  1. Excel VBA Maske erstellen - Similar Threads - Excel VBA Maske

  2. VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.

    in Microsoft Excel Hilfe
    VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.: Hallo zusammen, Eine Tabelle mit 9 Worksheets, Datenblatt, Studien, Studie_1 ...Studie_7. Auf dem Deckblatt werden in Zelle B4-B10 die Namen der Studien eingetragen. Davon abhängig ob ein Name...
  3. Excel VBA Spalten mit Ordnerinhalt vergleichen

    in Microsoft Excel Hilfe
    Excel VBA Spalten mit Ordnerinhalt vergleichen: Hallo, Bin ehr Excel VBA Neuling, Würde aber gerne in einer bestehender Tabelle die Auflistung der Ordner mit dem eigentlichen Stand in den besagten Ordner kontrollieren. Also in der Spalte Q10...
  4. Array aus Excel Tabelle einlesen Word VBA

    in Microsoft Excel Hilfe
    Array aus Excel Tabelle einlesen Word VBA: Hallo, ich benötige in einer Word Datei die Werte einer Excel Datei. Ich würde gerne eine Spalte als Array einlesen. Wie das Array ein lesen in Excel geht weiß ich, aber wie schaffe ich den...
  5. Dynamische Tabellen mit automatischer Aktualisierung

    in Microsoft Excel Hilfe
    Dynamische Tabellen mit automatischer Aktualisierung: Hallo in die Runde! Vorab schon mal vielen Dank für alle Mühen und die Hilfe! Ich habe folgendes Anliegen: Ich habe eine Geräteliste als Excel Datei mit einigen verschiedenen Tabellenblättern...
  6. (Excel) Dynamische Tabelle, VBA, fehlende Formatierung?

    in Microsoft Excel Hilfe
    (Excel) Dynamische Tabelle, VBA, fehlende Formatierung?: Liebe Experten, Gefilterte Daten sollen in ein Listobject übertragen werden. Für das Listobject habe ich ein Template angelegt, dass alle Formatierungen (u.a. bedingte Formatierung etc.) enthält....
  7. Speichern mit dem Titel der Zelle A2

    in Microsoft Excel Hilfe
    Speichern mit dem Titel der Zelle A2: Moin moin, Ich habe per Makro einen Arbeitsablauf aufgezeichnet der soweit auch funktioniert. Dieser Endet jedoch im "Speichern Unter" Fenster, welches durch das Klicken von "Drucken als PDF"...
  8. Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)

    in Microsoft Excel Hilfe
    Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.): Hallo, ich benötige Hilfe für ein Problem, welches ich leider selbst schwerlich als Anfänger nicht lösen kann: Ich möchte von dem Tabellenblatt "Tabelle1" aus den Zellen B8:B14, K8:K14, B18:B25,...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden