Clever-Excel-Forum › Office-Anwendungen › Excel v
Code Optimierung - Mein Projekt

Thema geschlossen 
Baumstrukturmodus
Code Optimierung - Mein Projekt
sandormiles Offline
pausiert
Registriert seit: 25.06.2015
Version(en): Office365
#1
10.06.2016, 20:11 (Dieser Beitrag wurde zuletzt bearbeitet: 10.06.2016, 20:22 von sandormiles.)
Hallo,

ich bin jetzt dabei mein Projekt einfach nochmal aufzusetzen und hoffe, dass das ganze übersichtlicher wird. In der Anlage gleich mal meine Datei. Wenn was auffällt, was man anders machen könnte oder zwingend sollte, dann bin ich für jeden Hinweis dankbar.

Eine kurze Beschreibung will ich noch geben, wo das ganze mal hin soll. In meiner Dienststelle gibt es kein wirkliches Programme, um bestimmte Akten zu erfassen. Klingt komisch, ist aber so. Es gibt mehrere Arbeitsgruppen. In der Gruppe, wo die Akte zuerst bearbeitet wird, dort gibt es ein Programm, aber nicht für die Rechtsbehelfs-Gruppe. Das soll nun dieses Tool ändern. Es wird also im Ergebnis darum gehen, dass mit dem Tool Daten angelegt, geändert und natürlich auch gesucht werden können.

Anfangen möchte ich mit der Suchfunktion. Die Suche funktioniert soweit. Derzeit kann ich über die Eingabe in das Textfeld "Az. 6er-Block", "Name" und "Straße" mit nur noch einem Button entsprechende Datensätze suchen. Hierfür nutze ich folgenden Code:

Code:
Private Sub Suchen_Click()
On Error GoTo EERR

Dim Suche As String
Dim firstAddress
Dim i As Integer


' Datensatz suchen#####

   ' Wenn kein Suchbegriff, dann Messagebox#####
   If TextBox2.Text = "" And TextBox3.Text = "" And TextBox48.Text = "" Then
       MsgBox "Geben Sie bitte einen Suchbegriff ein!"
   Exit Sub
   
   
   If TextBox2.Value <> "" Then TextBox3.Locked = True
   
'    '#####


   Else
   

   ' Wenn Suchbegriff 'Az. 6er-Block'#####
   If TextBox2.Value <> "" Then


           Suche = TextBox2.Text
           Set rngFind = Columns("B:B").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then

               Unload Me
               UserForm21.Show

           Else:
               Unload Me
               UserForm2.Show
           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -1).Value
                       ListBox1.List(i, 1) = rngFind
                       ListBox1.List(i, 2) = rngFind.Offset(0, 1).Value
                       ListBox1.List(i, 3) = rngFind.Offset(0, 2).Value
                       ListBox1.List(i, 4) = rngFind.Offset(0, 16).Value
                       ListBox1.List(i, 5) = rngFind.Offset(0, 17).Value


                       Set rngFind = Columns("B:B").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -1).Value
               TextBox2.Text = rngFind.Offset(0, 0).Value
               TextBox3.Text = rngFind.Offset(0, 1).Value
               TextBox4.Text = rngFind.Offset(0, 2).Value
               TextBox6.Text = rngFind.Offset(0, 3).Value
               ComboBox5.Text = rngFind.Offset(0, 4).Value
               ComboBox2.Text = rngFind.Offset(0, 5).Value
               CheckBox1 = rngFind.Offset(0, 6) = "X"
               ComboBox3.Text = rngFind.Offset(0, 7).Value
               TextBox10.Text = rngFind.Offset(0, 8).Value
               TextBox11.Text = rngFind.Offset(0, 9).Value
               TextBox12.Text = rngFind.Offset(0, 10).Value
               TextBox13.Text = rngFind.Offset(0, 11).Value
               ComboBox1.Text = rngFind.Offset(0, 12).Value
               ComboBox4.Text = rngFind.Offset(0, 13).Value
               TextBox44.Text = rngFind.Offset(0, 14).Value
               TextBox16.Text = rngFind.Offset(0, 15).Value
               TextBox48.Text = rngFind.Offset(0, 16).Value
               TextBox49.Text = rngFind.Offset(0, 17).Value

           ListBox1.Clear
           End If

   '    '#####


   
   ' Wenn Suchbegriff 'Name / Firma'#####
   If TextBox3.Value <> "" Then


           Suche = TextBox3.Text
           Set rngFind = Columns("C:C").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then

               Unload Me
               UserForm21.Show

           Else:
               Unload Me
               UserForm2.Show
           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
                       ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
                       ListBox1.List(i, 2) = rngFind
                       ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
                       ListBox1.List(i, 4) = rngFind.Offset(0, 15).Value
                       ListBox1.List(i, 5) = rngFind.Offset(0, 16).Value


                       Set rngFind = Columns("C:C").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -2).Value
               TextBox2.Text = rngFind.Offset(0, -1).Value
               TextBox3.Text = rngFind.Offset(0, 0).Value
               TextBox4.Text = rngFind.Offset(0, 1).Value
               TextBox6.Text = rngFind.Offset(0, 2).Value
               ComboBox5.Text = rngFind.Offset(0, 3).Value
               ComboBox2.Text = rngFind.Offset(0, 4).Value
               CheckBox1 = rngFind.Offset(0, 5) = "X"
               ComboBox3.Text = rngFind.Offset(0, 6).Value
               TextBox10.Text = rngFind.Offset(0, 7).Value
               TextBox11.Text = rngFind.Offset(0, 8).Value
               TextBox12.Text = rngFind.Offset(0, 9).Value
               TextBox13.Text = rngFind.Offset(0, 10).Value
               ComboBox1.Text = rngFind.Offset(0, 11).Value
               ComboBox4.Text = rngFind.Offset(0, 12).Value
               TextBox44.Text = rngFind.Offset(0, 13).Value
               TextBox16.Text = rngFind.Offset(0, 14).Value
               TextBox48.Text = rngFind.Offset(0, 15).Value
               TextBox49.Text = rngFind.Offset(0, 16).Value

           ListBox1.Clear
           End If

   '#####



   ' Wenn Suchbegriff 'Straße'#####
   If TextBox48.Value <> "" Then


           Suche = TextBox48.Text
           Set rngFind = Columns("R:R").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then

               Unload Me
               UserForm21.Show

           Else:
               Unload Me
               UserForm2.Show
           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -17).Value
                       ListBox1.List(i, 1) = rngFind.Offset(0, -16).Value
                       ListBox1.List(i, 2) = rngFind.Offset(0, -15).Value
                       ListBox1.List(i, 3) = rngFind.Offset(0, -15).Value
                       ListBox1.List(i, 4) = rngFind
                       ListBox1.List(i, 5) = rngFind.Offset(0, 1).Value


                       Set rngFind = Columns("R:R").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -17).Value
               TextBox2.Text = rngFind.Offset(0, -16).Value
               TextBox3.Text = rngFind.Offset(0, -15).Value
               TextBox4.Text = rngFind.Offset(0, -14).Value
               TextBox6.Text = rngFind.Offset(0, -13).Value
               ComboBox5.Text = rngFind.Offset(0, -12).Value
               ComboBox2.Text = rngFind.Offset(0, -11).Value
               CheckBox1 = rngFind.Offset(0, -10) = "X"
               ComboBox3.Text = rngFind.Offset(0, -9).Value
               TextBox10.Text = rngFind.Offset(0, -8).Value
               TextBox11.Text = rngFind.Offset(0, -7).Value
               TextBox12.Text = rngFind.Offset(0, -6).Value
               TextBox13.Text = rngFind.Offset(0, -5).Value
               ComboBox1.Text = rngFind.Offset(0, -4).Value
               ComboBox4.Text = rngFind.Offset(0, -3).Value
               TextBox44.Text = rngFind.Offset(0, -2).Value
               TextBox16.Text = rngFind.Offset(0, -1).Value
               TextBox48.Text = rngFind.Offset(0, 0).Value
               TextBox49.Text = rngFind.Offset(0, 1).Value

           ListBox1.Clear
           End If

End If
Exit Sub
EERR:

End Sub

Das er funktioniert, hab ich ja geschrieben. Lässt sich da noch was optimieren?

EDIT: Hab die Datei korrigiert. Starte nun nicht mehr direkt mit der UserForm!


Angehängte Dateien
.xlsm   VBARecht_NEU.xlsm (Größe: 64,91 KB / Downloads: 16)
Suchen
Top
Crazy Tom Offline
Benutzer
Registriert seit: 12.04.2014
Version(en): Office 365
#2
10.06.2016, 21:26
Hi

und dieser Code funktioniert?

Code:
Set rngFind = Columns("B:B").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
   If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf _
           & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then
       Unload Me
       UserForm21.Show
   Else:
       Unload Me
       UserForm2.Show
       Exit Sub
   End If
wo haste denn die Userform21 versteckt?

MfG Tom
Suchen
Top
sandormiles Offline
pausiert
ThreadStarter
Registriert seit: 25.06.2015
Version(en): Office365
#3
10.06.2016, 22:28
Nabend Tom!


Nö, kann so nicht funktionieren... ich bin einfach zu schnell. Hab den Teil nun mal rausgelöscht und denke, ich werde auf die Userform21 ganz verzichten. Meine Funktionen sollten denke ich doch auch in einer Userform funktionieren. Ich stell mal meine aktuelle Datei ein und lasse euch auch ne Chance, mal drüber zu schauen.

Code:
Private Sub Suchen_Click()
On Error GoTo EERR

Dim Suche As String
Dim firstAddress
Dim i As Integer
Dim Ende As Long


' Datensatz suchen#####

   ' Wenn kein Suchbegriff, dann Messagebox#####
   If TextBox2.Text = "" And TextBox3.Text = "" And TextBox48.Text = "" Then
       MsgBox "Geben Sie bitte einen Suchbegriff ein!"
   Exit Sub
   
   
   If TextBox2.Value <> "" Then TextBox3.Locked = True
   
'    '#####


   Else
   

   ' Wenn Suchbegriff 'Az. 6er-Block'#####
   If TextBox2.Value <> "" Then


           Suche = TextBox2.Text
           Set rngFind = Columns("B:B").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then


           '    Neues Verfahren anlegen'#####
           With ActiveSheet
               Ende = .Cells(Rows.Count, 1).End(xlUp).Row
           End With
           
           'TextBox1.Text = ""
               TextBox1.Value = Cells(Ende, 1).Value + 1
               TextBox2.SetFocus
               
               
           'Alle Textboxen, Comboboxen werden entsperrt#####
              For Each ctlControl In Me.Controls
                 If TypeName(ctlControl) = "TextBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "ComboBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "CheckBox" Then ctlControl.Locked = False
              Next ctlControl
           '#####
           
           
           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -1).Value
                       ListBox1.List(i, 1) = rngFind
                       ListBox1.List(i, 2) = rngFind.Offset(0, 1).Value
                       ListBox1.List(i, 3) = rngFind.Offset(0, 2).Value
                       ListBox1.List(i, 4) = rngFind.Offset(0, 16).Value
                       ListBox1.List(i, 5) = rngFind.Offset(0, 17).Value


                       Set rngFind = Columns("B:B").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -1).Value
               TextBox2.Text = rngFind.Offset(0, 0).Value
               TextBox3.Text = rngFind.Offset(0, 1).Value
               TextBox4.Text = rngFind.Offset(0, 2).Value
               TextBox6.Text = rngFind.Offset(0, 3).Value
               ComboBox5.Text = rngFind.Offset(0, 4).Value
               ComboBox2.Text = rngFind.Offset(0, 5).Value
               CheckBox1 = rngFind.Offset(0, 6) = "X"
               ComboBox3.Text = rngFind.Offset(0, 7).Value
               TextBox10.Text = rngFind.Offset(0, 8).Value
               TextBox11.Text = rngFind.Offset(0, 9).Value
               TextBox12.Text = rngFind.Offset(0, 10).Value
               TextBox13.Text = rngFind.Offset(0, 11).Value
               ComboBox1.Text = rngFind.Offset(0, 12).Value
               ComboBox4.Text = rngFind.Offset(0, 13).Value
               TextBox44.Text = rngFind.Offset(0, 14).Value
               TextBox16.Text = rngFind.Offset(0, 15).Value
               TextBox48.Text = rngFind.Offset(0, 16).Value
               TextBox49.Text = rngFind.Offset(0, 17).Value

           ListBox1.Clear
           End If

   '    '#####


   
   ' Wenn Suchbegriff 'Name / Firma'#####
   If TextBox3.Value <> "" Then


           Suche = TextBox3.Text
           Set rngFind = Columns("C:C").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then

           '    Neues Verfahren anlegen'#####
           With ActiveSheet
               Ende = .Cells(Rows.Count, 1).End(xlUp).Row
           End With
           
           'TextBox1.Text = ""
               TextBox1.Value = Cells(Ende, 1).Value + 1
               TextBox2.SetFocus
               
               
           'Alle Textboxen, Comboboxen werden entsperrt#####
              For Each ctlControl In Me.Controls
                 If TypeName(ctlControl) = "TextBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "ComboBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "CheckBox" Then ctlControl.Locked = False
              Next ctlControl
           '#####


           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
                       ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
                       ListBox1.List(i, 2) = rngFind
                       ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
                       ListBox1.List(i, 4) = rngFind.Offset(0, 15).Value
                       ListBox1.List(i, 5) = rngFind.Offset(0, 16).Value


                       Set rngFind = Columns("C:C").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -2).Value
               TextBox2.Text = rngFind.Offset(0, -1).Value
               TextBox3.Text = rngFind.Offset(0, 0).Value
               TextBox4.Text = rngFind.Offset(0, 1).Value
               TextBox6.Text = rngFind.Offset(0, 2).Value
               ComboBox5.Text = rngFind.Offset(0, 3).Value
               ComboBox2.Text = rngFind.Offset(0, 4).Value
               CheckBox1 = rngFind.Offset(0, 5) = "X"
               ComboBox3.Text = rngFind.Offset(0, 6).Value
               TextBox10.Text = rngFind.Offset(0, 7).Value
               TextBox11.Text = rngFind.Offset(0, 8).Value
               TextBox12.Text = rngFind.Offset(0, 9).Value
               TextBox13.Text = rngFind.Offset(0, 10).Value
               ComboBox1.Text = rngFind.Offset(0, 11).Value
               ComboBox4.Text = rngFind.Offset(0, 12).Value
               TextBox44.Text = rngFind.Offset(0, 13).Value
               TextBox16.Text = rngFind.Offset(0, 14).Value
               TextBox48.Text = rngFind.Offset(0, 15).Value
               TextBox49.Text = rngFind.Offset(0, 16).Value

           ListBox1.Clear
           End If

   '#####



   ' Wenn Suchbegriff 'Straße'#####
   If TextBox48.Value <> "" Then


           Suche = TextBox48.Text
           Set rngFind = Columns("R:R").Find(what:=Suche, lookat:=xlWhole, LookIn:=xlValues)
           If rngFind Is Nothing Then
           If MsgBox("Dieser Name existiert noch nicht!" & vbCrLf & vbCrLf & "Möchten Sie einen neuen Datensatz anlegen?", vbQuestion + vbYesNo, "Nachfragen") = vbYes Then

           '    Neues Verfahren anlegen'#####
           With ActiveSheet
               Ende = .Cells(Rows.Count, 1).End(xlUp).Row
           End With
           
           'TextBox1.Text = ""
               TextBox1.Value = Cells(Ende, 1).Value + 1
               TextBox2.SetFocus
               
               
           'Alle Textboxen, Comboboxen werden entsperrt#####
              For Each ctlControl In Me.Controls
                 If TypeName(ctlControl) = "TextBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "ComboBox" Then ctlControl.Locked = False
                 If TypeName(ctlControl) = "CheckBox" Then ctlControl.Locked = False
              Next ctlControl
           '#####
           
           
           Exit Sub

           End If


           Else
           i = 0
           firstAddress = rngFind.Address
                   Do

                       ListBox1.AddItem
                       ListBox1.List(i, 0) = rngFind.Offset(0, -17).Value
                       ListBox1.List(i, 1) = rngFind.Offset(0, -16).Value
                       ListBox1.List(i, 2) = rngFind.Offset(0, -15).Value
                       ListBox1.List(i, 3) = rngFind.Offset(0, -15).Value
                       ListBox1.List(i, 4) = rngFind
                       ListBox1.List(i, 5) = rngFind.Offset(0, 1).Value


                       Set rngFind = Columns("R:R").FindNext(rngFind)

                       i = i + 1

                   Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

           End If
           End If

           If ListBox1.ListCount = 1 Then
               TextBox1.Text = rngFind.Offset(0, -17).Value
               TextBox2.Text = rngFind.Offset(0, -16).Value
               TextBox3.Text = rngFind.Offset(0, -15).Value
               TextBox4.Text = rngFind.Offset(0, -14).Value
               TextBox6.Text = rngFind.Offset(0, -13).Value
               ComboBox5.Text = rngFind.Offset(0, -12).Value
               ComboBox2.Text = rngFind.Offset(0, -11).Value
               CheckBox1 = rngFind.Offset(0, -10) = "X"
               ComboBox3.Text = rngFind.Offset(0, -9).Value
               TextBox10.Text = rngFind.Offset(0, -8).Value
               TextBox11.Text = rngFind.Offset(0, -7).Value
               TextBox12.Text = rngFind.Offset(0, -6).Value
               TextBox13.Text = rngFind.Offset(0, -5).Value
               ComboBox1.Text = rngFind.Offset(0, -4).Value
               ComboBox4.Text = rngFind.Offset(0, -3).Value
               TextBox44.Text = rngFind.Offset(0, -2).Value
               TextBox16.Text = rngFind.Offset(0, -1).Value
               TextBox48.Text = rngFind.Offset(0, 0).Value
               TextBox49.Text = rngFind.Offset(0, 1).Value

           ListBox1.Clear
           End If
   End If


Exit Sub
EERR:
End Sub


Angehängte Dateien
.xlsm   VBARecht_NEU.xlsm (Größe: 77,42 KB / Downloads: 16)
Suchen
Top
snb Offline
Benutzer
Registriert seit: 29.09.2015
Version(en): 2030,5
#4
11.06.2016, 17:24 (Dieser Beitrag wurde zuletzt bearbeitet: 11.06.2016, 17:24 von snb.)
Diese Code reicht in Userform_Initialize

Code:
Private Sub UserForm_Initialize()
    
End Sub
Man bracuht Initialize nur für was man im Design Mode nicht kann: z.B. populate eines ListBox oder Combobox.


Diese Code reicht in

Code:
Private Sub Beenden_Click()
  unload me
End Sub

Lösche 'on error gotoErRR' überall.
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • sandormiles
Homepage Suchen
Top
sandormiles Offline
pausiert
ThreadStarter
Registriert seit: 25.06.2015
Version(en): Office365
#5
21.06.2016, 20:29
Folgendes Problem stellt sich mir. Suchen und ändern von Datensätzen funktioniert soweit. Wenn ich nun aber wie folgt vorgehe, entsperrt er mir die TextBox2 (Az. 6er-Block), was er eigentlich nicht soll.

Folgende Schritt gehe ich durch:
1. In einem der blauen Felder  mit "*" suchen.
2. In der ListBox einen Eintrag auswählen.
3. Button "Verfahren ändern" klicken. Es werden alle Felder entsperrt, wobei TextBox2 u.a. ausgenommen sind.
4. Klicke ich nun in die TextBox3 und ändere den Inhalt, dann entsperrt er die TextBox2. Aber warum? Sollte die bei dem Code

Code:
Private Sub TextBox3_Change()

   If TextBox3.Text <> "" Then             'Name / Firma
           TextBox2.Locked = True          'Az. 6er-Block
           TextBox2.BackColor = &H80000005
   Else:   TextBox2.Locked = False
           TextBox2.BackColor = &HFFC0C0
   
   End If
   
   
   If TextBox3.Text <> "" Then             'Az. 6er-Block
           TextBox5.Locked = True          'Straße
           TextBox5.BackColor = &H80000005
   Else:   TextBox5.Locked = False
           TextBox5.BackColor = &HFFC0C0
   
   End If
   
End Sub

nicht gesperrt bleiben?

Danke und Grüße


Angehängte Dateien
.xlsm   VBARecht_NEU (1).xlsm (Größe: 75,5 KB / Downloads: 10)
Suchen
Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#6
22.06.2016, 06:58
Hallo,

setze dir einen Haltepunkt (F9-Taste) oder füge einen Stop

Code:
Private Sub TextBox3_Change()
    Stop
    If TextBox3.Text <> "" Then             'Name / Firma
            TextBox2.Locked = True          'Az. 6er-Block
            TextBox2.BackColor = &H80000005
    Else:   TextBox2.Locked = False
            TextBox2.BackColor = &HFFC0C0
    
    End If
    
    
    If TextBox3.Text <> "" Then             'Az. 6er-Block
            TextBox5.Locked = True          'Straße
            TextBox5.BackColor = &H80000005
    Else:   TextBox5.Locked = False
            TextBox5.BackColor = &HFFC0C0
    
    End If
    
End Sub

im Code ein und schaue im Einzelschritt (F8-Taste) wie Excel den Code abarbeitet.
Gruß Stefan
Win 10 / Office 2016
Suchen
Top
snb Offline
Benutzer
Registriert seit: 29.09.2015
Version(en): 2030,5
#7
22.06.2016, 13:01
Code:
Private Sub TextBox3_Change
  TextBox2.enabled= TextBox3.Text =""
End Sub
Homepage Suchen
Top
sandormiles Offline
pausiert
ThreadStarter
Registriert seit: 25.06.2015
Version(en): Office365
#8
22.06.2016, 20:29
@Steffl: Mit einer Textbox und der Funktion, muss sich die Box ja spätestens entsperren, wenn die Box in der ich was ändere leer ist. Das soll so ja definitiv nicht sein. Ich sehe in der Konsequenz keine andere Möglichkeit als hier 2 Textboxen zu verwenden und je nach Funktion dann eine aus- und die andere einzublenden.

@snb: Dein Code wäre eine Variante, wäre da nicht, dass der Text nur noch schwach grau ist.
Suchen
Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#9
22.06.2016, 22:04
Hallo,

ich habe das mal nachgestellt. Ich konnte in der Textbox nichts eintragen. Dein Code ist nach meiner Meinung nicht immer stimmig. So zum Beispiel im CommandButton6_Click heißt es

PHP-Code:
Private Sub CommandButton6_Click()

   'Variable deklarieren#####
   Dim Suche As String
   Dim firstAddress
   Dim i As Integer
   Dim Ende As Long
   Dim ctlControl As Control
   
   
   ' Datensatz suchen#####
   
   ' Wenn kein Suchbegriff, dann Messagebox#####
   If TextBox2.Text = "" And TextBox3.Text = "" And TextBox5.Text = "" Then
   MsgBox "Geben Sie bitte einen Suchbegriff ein!"
   Exit Sub
   
   
   If TextBox2.Value <> "" Then TextBox3.Locked = True
   
   '    '#####
   
   
   Else 

Wenn Textbox2, Textbox3 und textbox5 leer sind gibt eine Meldung aus und verlasse die Prozedur. Die danach folgende Codezeile wird niemals erreicht, denn wenn nur eine Textbox der drei gefüllt ist, wird mit dem Else-Zweig weiter gemacht.
Gruß Stefan
Win 10 / Office 2016
Suchen
Top
sandormiles Offline
pausiert
ThreadStarter
Registriert seit: 25.06.2015
Version(en): Office365
#10
23.06.2016, 19:06
Ja, an der Stelle war der nicht stimmig. Kann nur Sinn machen, wenn auch die TextBox5 gesperrt wird, wenn was in der TextBox2 steht...

Wie geschrieben, das Problem hab ich über mehrere Textboxen gelöst. Um alle Funktionen abzubilden, wird nun über die TextBox2 noch 2 weitere Boxen gelegt. Je Funktion wird die entsprechende TextBox ein- oder ausgeblendet. Tut zumindest was es soll. Die Kernfunktionen der Userform funktionieren. Einige Korrekturen und kleine Anpassungen sind sicher noch notwendig.

Eine Sache konnte ich noch nicht lösen und finde irgendwie nicht die passende Lösung. Trage ich in das Feld "Vermerk" Text ein und speichere den, dann schreibt er mir den Text so um, dass bei jedem Wort der erste Buchstabe großgeschrieben wird. Die Spalt im Tabellenblatt hab ich schon formatiert, bringt aber nichts. Dachte wenn die Spalte die Eigenschaft "Text" hat, sollte der Text auch 1:1 übernommen werden!ß  Huh

Grüße und bis hierher Danke!


Angehängte Dateien
.xlsm   Test.xlsm (Größe: 121,44 KB / Downloads: 12)
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste