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
|