Thema Datum  Von Nutzer Rating
Antwort
Rot ListBox gibt Text an Textbox
01.08.2011 09:49:08 Dome
NotSolved
02.08.2011 11:31:40 Dome
NotSolved
02.08.2011 12:13:00 Dekor
NotSolved
02.08.2011 12:47:11 Dome
NotSolved
03.08.2011 12:05:43 Dome
NotSolved

Ansicht des Beitrags:
Von:
Dome
Datum:
01.08.2011 09:49:08
Views:
2103
Rating: Antwort:
  Ja
Thema:
ListBox gibt Text an Textbox

Hallo,

ich hab ein kleines Problem.

Ich habe zwei Listboxen, diese Listboxen sind beim Makieren synchronisiert. Also die markierte Spalte in Listbox1 eins ist auch in Listbox2 markiert.
Listbox2.text wird an eine Textbox übergeben.

Problem:

Wenn ich meine Userform starte funkioniert das auch alles wie es soll. Jetzt schließ ich die Userform und starte sie neu.
jetzt wird der text nicht mehr an die Textbox übergeben. Erst wenn ich in der Listbox2 eine Spalte anklick.
Userform wieder schließen und neu Starten geht es wieder. Wieder schließen und neu starten geht es nicht mehr.

Kann mir jemand weiterhelfen? Ich möchte gern das es immer geht und nicht die Userform schließen und wieder öffnen oder in Listbox2 klicken.
es soll alles über Listbox1 ausgwählt werden können.
Ich denke irgendwo wird ein Wert der Listbox auf 0 oder 1 gesetzt und das aber nicht im VBA code.

Mein Code:

' Setzt den X-Button oben rechts ausergefächt
'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'If CloseMode <> 1 Then
        'Cancel = 1
    'End If
'End Sub

Public Function nur_Zahlen(KeyAscii As MSForms.ReturnInteger) As Integer
' Es wird nur die Eingabe von Zahlen zugelassen
' aus , wird . gemacht
'
'Verwendung beim  KEYPRESS Event des jeweiligen Controls
'KeyAscii = nur_Zahlen(KeyAscii)
 
  Select Case KeyAscii
          Case 44 ' , in .
              nur_Zahlen = 46
          Case 8, 46, 48 To 57
              nur_Zahlen = KeyAscii
          Case Else
              nur_Zahlen = 0
  End Select
End Function


Private Sub ComboBox1_Change()

If ComboBox1.Text = "Schaftfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\schaftfräser.jpg")
  End If
If ComboBox1.Text = "Torsusfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Trosusfräser.jpg")
  End If
If ComboBox1.Text = "Bohrnutenfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Bohrnutfräser.jpg")
  End If
If ComboBox1.Text = "Langlochfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Langlochfräser.jpg")
  End If
If ComboBox1.Text = "Vollradiusfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Vollradisufräser.jpg")
  End If
If ComboBox1.Text = "Kugelfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Kugelfräser.jpg")
  End If
If ComboBox1.Text = "Walzenstirnfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Walzenstirn.jpg")
  End If
If ComboBox1.Text = "Walzenfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\walzfräser.jpg")
  End If
If ComboBox1.Text = "Fasenfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Fasenfräser.jpg")
  End If
If ComboBox1.Text = "Formfräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\keen.jpg")
  End If
If ComboBox1.Text = "Gewindebohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Gewindebohrer.jpg")
  End If
If ComboBox1.Text = "Sackloch" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Sackloch.jpg")
  End If
If ComboBox1.Text = "Gewindeformer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Gewindeformer.jpg")
  End If
If ComboBox1.Text = "Gewindefräser" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Gewindefräser.jpg")
  End If
If ComboBox1.Text = "Anbohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Anbohrer.jpg")
  End If
If ComboBox1.Text = "Pilotbohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Pilotbohrer.jpg")
  End If
If ComboBox1.Text = "Stufenbohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Stufenbohrer.jpg")
  End If
If ComboBox1.Text = "Zentrierbohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Zentrierbohrer.jpg")
  End If
If ComboBox1.Text = "Tieflochbohrer" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Tieflochbohrer.jpg")
  End If
If ComboBox1.Text = "Entgrater" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Entgrater.jpg")
  End If
If ComboBox1.Text = "Kegelsenker" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Kegelsenker.jpg")
  End If
If ComboBox1.Text = "Zapfensenker" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Flachsenker.jpg")
  End If
If ComboBox1.Text = "Planmesserkopf" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Messerkopf.jpg")
  End If
If ComboBox1.Text = "Fasenmesserkopf" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\Messerkopf-fase.jpg")
  End If
If ComboBox1.Text = "Eckenmesserkopf" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\eckmesserkopf.jpg")
  End If
If ComboBox1.Text = "Messerkopf-Form" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\keen.jpg")
  End If
If ComboBox1.Text = "Reibahle" Then
    Image4.Picture = LoadPicture("C:\Users\dhofmann\Pictures\reibahle.jpg")
  End If
 
 
 
 
 
 
End Sub

Private Sub CommandButton1_Click()
Dim x As Integer
Range("O2") = TextBox1.Text
Worksheets("WKZ").Activate
ActiveSheet.Range("A1").Select
ListBox1.Clear
ListBox2.Clear

'Combobox auswahl wird einer Nummer zugewiesen


If ComboBox1.Text = "Schaftfräser" Then
    x = 10
  End If
If ComboBox1.Text = "Torsusfräser" Then
    x = 11
  End If
If ComboBox1.Text = "Bohrnutenfräser" Then
    x = 12
  End If
If ComboBox1.Text = "Langlochfräser" Then
    x = 13
  End If
If ComboBox1.Text = "Vollradiusfräser" Then
    x = 20
  End If
If ComboBox1.Text = "Kugelfräser" Then
    x = 21
  End If
If ComboBox1.Text = "Walzenstirnfräser" Then
    x = 30
  End If
If ComboBox1.Text = "Walzenfräser" Then
    x = 31
  End If
If ComboBox1.Text = "Fasenfräser" Then
    x = 40
  End If
If ComboBox1.Text = "Formfräser" Then
    x = 50
  End If
If ComboBox1.Text = "Gewindebohrer" Then
    x = 60
  End If
If ComboBox1.Text = "Sackloch" Then
    x = 61
  End If
If ComboBox1.Text = "Gewindeformer" Then
    x = 62
  End If
If ComboBox1.Text = "Gewindefräser" Then
    x = 63
  End If
If ComboBox1.Text = "Anbohrer" Then
    x = 70
  End If
If ComboBox1.Text = "Pilotbohrer" Then
    x = 71
  End If
If ComboBox1.Text = "Stufenbohrer" Then
    x = 72
  End If
If ComboBox1.Text = "Zentrierbohrer" Then
    x = 73
  End If
If ComboBox1.Text = "Tieflochbohrer" Then
    x = 74
  End If
If ComboBox1.Text = "Entgrater" Then
    x = 80
  End If
If ComboBox1.Text = "Kegelsenker" Then
    x = 81
  End If
If ComboBox1.Text = "Zapfensenker" Then
    x = 82
  End If
If ComboBox1.Text = "Planmesserkopf" Then
    x = 90
  End If
If ComboBox1.Text = "Fasenmesserkopf" Then
    x = 91
  End If
If ComboBox1.Text = "Eckenmesserkopf" Then
    x = 92
  End If
If ComboBox1.Text = "Messerkopf-Form" Then
    x = 93
  End If
If ComboBox1.Text = "Reibahle" Then
    x = 100
  End If
 

 


If x = 10 Or x = 12 Or x = 13 Or x = 30 Or x = 92 Then
UserForm2.Show

Else
Unload UserForm2

End If
If x = 11 Or x = 20 Or x = 21 Then
UserForm3.Show

Else
Unload UserForm3

End If

If x = 40 Or x = 70 Or x = 73 Or x = 80 Or x = 81 Or x = 91 Then
UserForm4.Show

Else
Unload UserForm4

End If


Dim Cello As Range
Dim Zelle As Range

'Wenn nichts in den 6 Zeilen eingetragen ist kommt eine MsgBox
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Or ComboBox1.Text = "" Or ComboBox2.Text = "" Or ComboBox3.Text = "" Then
MsgBox "Bitte alle Felder ausfüllen"
Exit Sub

End If

 

ListBox1.Clear

'Kontrolle ob es das WKZ schon so angelegt ist
For Each Cello In Range("b3:b65536")

If Cello = "-" & TextBox1.Text & "-" & TextBox2.Text & "-" & x Then
Cello.Select


If ActiveCell.Offset(0, 2) = TextBox1.Text Then
D1 = 1
Else
D1 = 0
    End If
   
If ActiveCell.Offset(0, 3) = TextBox2.Text Then
D2 = 1
Else
D2 = 0
    End If
   
If ActiveCell.Offset(0, 4) = ComboBox1.Text Then
D3 = 1
Else
D3 = 0
    End If
   
If ActiveCell.Offset(0, 5) = ComboBox2.Text Then
D4 = 1
Else
D4 = 0
    End If
   
If ActiveCell.Offset(0, 6) = TextBox3.Text Then
D5 = 1
Else
D5 = 0
    End If
   
If ActiveCell.Offset(0, 7) = ComboBox3.Text Then
D6 = 1
Else
D6 = 0
    End If
   
If ActiveCell.Offset(0, 9) = TextBox9.Text Then
D7 = 1
Else
D7 = 0
    End If
   
If D1 + D2 + D3 + D4 + D5 + D6 + D7 = 7 Then
MsgBox "Werkzeug bereits vorhanden!"
Exit Sub
    End If
   
        End If
Next

 


'Abfrage ob das WKz angelegt werden soll ja oder nein

If MsgBox("Möchten Sie das WKZ anlegen?", vbOKCancel) = vbCancel Then Exit Sub

'Schreiben der Werte in bestimmte Zellen
ActiveSheet.Range("A3:A65536").Select
For Each Zelle In Selection
If Zelle = "" Then
Zelle.Select
ActiveCell.Offset(0, 0) = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Offset(0, 1) = "-" & TextBox1.Text & "-" & TextBox2.Text & "-" & x
ActiveCell.Offset(0, 2) = "-" & ComboBox2.Text & "-" & ComboBox3.Text
ActiveCell.Offset(0, 3) = TextBox1.Text     '' Durchmesser
ActiveCell.Offset(0, 4) = TextBox2.Text     ''Zähnezahl
ActiveCell.Offset(0, 5) = ComboBox1.Text     ''Form
ActiveCell.Offset(0, 6) = ComboBox2.Text     ''Spannart
ActiveCell.Offset(0, 7) = TextBox3.Text     ''Schaftdurchmesser
ActiveCell.Offset(0, 8) = ComboBox3.Text     ''Aufnahme
ActiveCell.Offset(0, 9) = TextBox8.Text     ''Bemerkung
ActiveCell.Offset(0, 10) = TextBox9.Text     ''Fase/Radius/Winkel


ListBox1.AddItem Zelle.Offset(0, 0) & Zelle.Offset(0, 1) & Zelle.Offset(0, 10) & Zelle.Offset(0, 2)
ListBox2.AddItem Zelle.Offset(0, 9)
ListBox2.Selected(0) = True
ListBox1.Selected(0) = True

''Clear
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
Image4.Picture = LoadPicture()
ActiveWorkbook.Save


Exit Sub
End If
Next Zelle
  

 

 

                                    

 

 


End Sub

Private Sub CommandButton2_Click()
Dim Y As Integer
Worksheets("WKZ").Activate
ActiveSheet.Range("A1").Select

'Combobox auswahl wird einer Nummer zugewiesen

If ComboBox1.Text = "Schaftfräser" Then
    Y = 10
  End If
If ComboBox1.Text = "Torsusfräser" Then
    Y = 11
  End If
If ComboBox1.Text = "Bohrnutenfräser" Then
    Y = 12
  End If
If ComboBox1.Text = "Langlochfräser" Then
    Y = 13
  End If
If ComboBox1.Text = "Vollradiusfräser" Then
    Y = 20
  End If
If ComboBox1.Text = "Kugelfräser" Then
    Y = 21
  End If
If ComboBox1.Text = "Walzenstirnfräser" Then
    Y = 30
  End If
If ComboBox1.Text = "Walzenfräser" Then
    Y = 31
  End If
If ComboBox1.Text = "Fasenfräser" Then
    Y = 40
  End If
If ComboBox1.Text = "Formfräser" Then
    Y = 50
  End If
If ComboBox1.Text = "Gewindebohrer" Then
    Y = 60
  End If
If ComboBox1.Text = "Sackloch" Then
    Y = 61
  End If
If ComboBox1.Text = "Gewindeformer" Then
    Y = 62
  End If
If ComboBox1.Text = "Gewindefräser" Then
    Y = 63
  End If
If ComboBox1.Text = "Anbohrer" Then
    Y = 70
  End If
If ComboBox1.Text = "Pilotbohrer" Then
    Y = 71
  End If
If ComboBox1.Text = "Stufenbohrer" Then
    Y = 72
  End If
If ComboBox1.Text = "Zentrierbohrer" Then
    Y = 73
  End If
If ComboBox1.Text = "Tieflochbohrer" Then
    Y = 74
  End If
If ComboBox1.Text = "Entgrater" Then
    Y = 80
  End If
If ComboBox1.Text = "Kegelsenker" Then
    Y = 81
  End If
If ComboBox1.Text = "Zapfensenker" Then
    Y = 82
  End If
If ComboBox1.Text = "Planmesserkopf" Then
    Y = 90
  End If
If ComboBox1.Text = "Fasenmesserkopf" Then
    Y = 91
  End If
If ComboBox1.Text = "Eckenmesserkopf" Then
    Y = 92
  End If
If ComboBox1.Text = "Messerkopf-Form" Then
    Y = 93
  End If
If ComboBox1.Text = "Reibahle" Then
    Y = 100
  End If

 


'WKZ Suche und anzeige der WKZ in einer Listbox
ListBox1.Clear
ListBox2.Clear

 

For Each Celle In Range("b3:b65536")
If TextBox1.Text = "" Or TextBox2.Text = "" Or ComboBox1.Text = "" Then
MsgBox "Bitte alle 3 Felder ausfüllen"
Exit Sub
End If

If Celle = "-" & TextBox1.Text & "-" & TextBox2.Text & "-" & Y Then
Celle.Select
ListBox1.AddItem Celle.Offset(0, -1) & Celle.Offset(0, 0) & Celle.Offset(0, 9) & Celle.Offset(0, 1)
ListBox2.AddItem Celle.Offset(0, 8) & vbTab & Celle.Offset(0, 9)
ListBox2.Selected(0) = True

End If
Next


If ListBox1.Selected(0) = flase Then
MsgBox "Kein WKZ gefunde"
Exit Sub
End If


'Clear
TextBox1.Text = ""
TextBox2.Text = ""
ComboBox1.Text = ""

 


End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal x As Single, ByVal Y As Single)
                          
 
  Dim Clip As DataObject
  Set Clip = New DataObject


  If Button = 2 Then          ' wenn rechte Maustaste gedrückt wurde
    With Clip
     .Clear                   ' Zwischenablage löschen
      .SetText ListBox1.Text  ' markierter Text der Listbox
      .PutInClipboard         ' in die Zwischenablage kopieren
    End With

End If
End Sub

 

Private Sub CommandButton3_Click()
'Button zum löschen
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
ListBox1.Clear
ListBox2.Clear
Image4.Picture = LoadPicture()

End Sub

Private Sub CommandButton4_Click()
     ThisWorkbook.Save

     Application.Quit

End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = nur_Zahlen(KeyAscii)
'Verhindert das schreiben von Bustaben

End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = nur_Zahlen(KeyAscii)
'Verhindert das schreiben von Bustaben

End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = nur_Zahlen(KeyAscii)
'Verhindert das schreiben von Bustaben
End Sub

Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = nur_Zahlen(KeyAscii)
'Verhindert das schreiben von Bustaben
End Sub
Private Sub ListBox2_Change()

ListBox1.ListIndex = ListBox2.ListIndex
TextBox8.Text = ListBox2.Text

End Sub
Private Sub ListBox1_Change()

ListBox2.ListIndex = ListBox1.ListIndex

End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot ListBox gibt Text an Textbox
01.08.2011 09:49:08 Dome
NotSolved
02.08.2011 11:31:40 Dome
NotSolved
02.08.2011 12:13:00 Dekor
NotSolved
02.08.2011 12:47:11 Dome
NotSolved
03.08.2011 12:05:43 Dome
NotSolved