Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Codeänderung bei UF

Codeänderung bei UF
10.08.2006 16:29:45
Maria
Hallo meine Excelprofis,
ich habe Dank dem Forum hier bereits den Nachfolgenden Code erhalten und habe da eine Bitte an Euch.
Zuerst mal mein Code:
--------------------------
Option Explicit

Private Sub cmdCancel_Click()
Unload Me
End Sub


Private Sub cmdOK_Click()
Dim lngNext As Long
Dim intIndex As Integer
For intIndex = 1 To 8
If Len(Controls("TextBox" & intIndex).Value) = 0 Then
MsgBox "Es fehlen noch Angaben!", vbInformation, "Hinweis"
Controls("TextBox" & intIndex).SetFocus
Exit Sub
End If
Next
With Sheets("VVC 33")
lngNext = .Cells(101, 2).End(xlUp).Row + 2
If lngNext < 13 Then lngNext = 13
.Cells(lngNext, 4) = ""
lngNext = lngNext + 1
.Cells(lngNext, 2) = CLng(TextBox1)
.Cells(lngNext, 3) = CLng(TextBox2)
.Cells(lngNext, 5) = "=" & TextBox3 & "="
.Cells(lngNext + 1, 5) = ":" & UCase(Replace(TextBox4, ":", "")) & ":"
.Cells(lngNext + 1, 6) = "(" & Replace(Replace(TextBox5, "(", ""), ")", "") & ")"
.Cells(lngNext, 8) = TextBox6.Text
.Cells(lngNext, 9) = CLng(TextBox7)
.Cells(lngNext + 2, 4) = "ENDE " & Replace(TextBox8, "ENDE ", "")
For intIndex = 1 To 8
Controls("TextBox" & intIndex).Value = ""
Next
TextBox2 = Format(Application.Max(.Range("C14:C100")) + 1, "00")
End With
End Sub


Private Sub Label8_Click()
End Sub


Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox5_Change()
End Sub


Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox8_Change()
End Sub


Private Sub UserForm_Activate()
Dim varList As Variant
varList = Array("BK", "L", "STK", "PKG", "KG")
TextBox2 = Format(Application.Max(Sheets("VVC 33").Range("C14:C100")) + 1, "00")
TextBox6.List = varList
End Sub

------------------------------
Und nun meine Bitte um Änderung wie folgt:
In der Textbox1 sollte immer die Zahl 33 stehen, die dann auch einegtragen werden sollte.
In der Textbox8 sollte der Wert aus Zelle F9 im Tabellenblatt mit dem Namen Grunddaten stehen.
Es ist aber so, das in besagter Zelle ein Name in Klammern steht so z.B.: (MUSTER, Mark)
Wenn es aber mittels UF in mein Formular eingetragen wird, sollte es ohne Klammern und wie folgt geschehen:
ENDE MUSTER, Mark
Und genau das sollte in der Textbox8 stehen.
Wichtig dabei, die Textbox1 und die Textbox8 sollten nie geleert werden.
Ich hoffe ich habe mich verständlich ausgedrückt und hoffe auf Eure Hilfe.
Recht herzlichen Dank im voraus.
Gruss aus Österreich

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Codeänderung bei UF
10.08.2006 20:30:46
fcs
Hallo Maria,
folgende Anpassung der Prozedur "Private Sub UserForm_Activate()" setzt die Werte für Textbox1 und Textbox8. Damit das Ganze funktioniert muss dein Objekt Textbox6 eine ComboBox oder eine ListBox sein.

Private Sub UserForm_Activate()
Dim varList As Variant
varList = Array("BK", "L", "STK", "PKG", "KG")
TextBox1.Value = 33
TextBox2 = Format(Application.Max(Sheets("VVC 33").Range("C14:C100")) + 1, "00")
TextBox6.List = varList
TextBox8 = "ENDE " & Mid(Worksheets("Grunddaten").Range("F9"), 2, _
Len(Worksheets("Grunddaten").Range("F9")) - 2)
End Sub

gruss
Franz
Anzeige
AW: Codeänderung bei UF
11.08.2006 15:36:56
Maria
Hallo,
Sorry das ich mich erst Heute melde, gestern war es mir schon zu spät, also erstmals Danke für Deine Hilfe, im großen und ganzen, war es das, was ich gesucht habe.
Hatte nur vergessen zu sagen, dass die Klammern über Zellformatierung mit (@) durchgeführt werden, habe aber das Problem selber lösen können, bzw. habe ich den Code Stümperhaft zusammengeklempnert.
Da gibt es jetzt nur noch ein kleines Problemchen.
Wenn ich jetzt über die UF meine Daten eintragen lasse (mittels cmdOK), werden mir die Textbox 1 und die Textbox 8 entleert.
Es müsste aber so sein, das die beiden Werte (aus Textbox 1 & 8) immer stehen bleiben.
Habe heute schon den ganze Tag daran herumprobiert, jedoch ohne Erfolg.
Wäre lieb wenn mir noch einmal jemand helfen könnte, hier mal mein jetziger Code:
---------------------------
Option Explicit

Private Sub cmdCancel_Click()
Unload Me
End Sub


Private Sub cmdOK_Click()
Dim lngNext As Long
Dim intIndex As Integer
For intIndex = 1 To 8
If Len(Controls("TextBox" & intIndex).Value) = 0 Then
MsgBox "Es fehlen noch Angaben!", vbInformation, "Hinweis"
Controls("TextBox" & intIndex).SetFocus
Exit Sub
End If
Next
With Sheets("VVC 33")
lngNext = .Cells(101, 2).End(xlUp).Row + 2
If lngNext < 13 Then lngNext = 13
.Cells(lngNext, 4) = ""
lngNext = lngNext + 1
.Cells(lngNext, 2) = CLng(TextBox1)
.Cells(lngNext, 3) = CLng(TextBox2)
.Cells(lngNext, 5) = "=" & TextBox3 & "="
.Cells(lngNext + 1, 5) = ":" & UCase(Replace(TextBox4, ":", "")) & ":"
.Cells(lngNext + 1, 6) = "(" & Replace(Replace(TextBox5, "(", ""), ")", "") & ")"
.Cells(lngNext, 8) = TextBox6.Text
.Cells(lngNext, 9) = CLng(TextBox7)
.Cells(lngNext + 2, 4) = "ENDE " & Replace(TextBox8, "ENDE ", "")
For intIndex = 1 To 8
Controls("TextBox" & intIndex).Value = ""
Next
TextBox2 = Format(Application.Max(.Range("C14:C100")) + 1, "00")
End With
End Sub


Private Sub Label8_Click()
End Sub


Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox5_Change()
End Sub


Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox8_Change()
End Sub


Private Sub UserForm_Activate()
Dim varList As Variant
varList = Array("BK", "L", "STK", "PKG", "KG")
TextBox1.Value = 33
TextBox2 = Format(Application.Max(Sheets("VVC 33").Range("C14:C100")) + 1, "00")
TextBox6.List = varList
TextBox8 = "ENDE " & Mid(Worksheets("Grunddaten").Range("F9"), 1, _
Len(Worksheets("Grunddaten").Range("F9")) - 0)
End Sub

---------------------------
Ich bedanke mich wieder im voraus und wünsche schon mal jetzt ein schönes Wochenende.
Maria
Anzeige
AW: Codeänderung bei UF
11.08.2006 15:48:07
fcs
Hallo Maria,
mit der For-Next-Schleife in folgendem Abschnitt setzt du mit dem OK-Button auch TextBox1 und TextBox8 auf "".

Private Sub cmdOK_Click()
For intIndex = 1 To 8
Controls("TextBox" & intIndex).Value = ""
Next
TextBox2 = Format(Application.Max(.Range("C14:C100")) + 1, "00")
End With
End Sub
Ändere
For intIndex = 1 To 8
ab in
For intIndex = 2 To 7

Gruß
Franz
AW: Codeänderung bei UF
11.08.2006 16:04:15
Maria
Hallo nochmals,
danke wieder für Deine rasche Antwort. Habe es so gemacht wie Du sagtest, leider werden nach dem klick auf den Button wieder alle Einträge gelöscht. Nachstehend mein Code für die Überprüfung, ob ich es überhaupt richtig gemacht habe.
Wo liegt denn jetzt der Fehler, oder was muss ich tun, bitte um weitere Hilfe.
------------------
Option Explicit

Private Sub cmdCancel_Click()
Unload Me
End Sub


Private Sub cmdOK_Click()
Dim lngNext As Long
Dim intIndex As Integer
For intIndex = 2 To 7
If Len(Controls("TextBox" & intIndex).Value) = 0 Then
MsgBox "Es fehlen noch Angaben!", vbInformation, "Hinweis"
Controls("TextBox" & intIndex).SetFocus
Exit Sub
End If
Next
With Sheets("VVC 33")
lngNext = .Cells(101, 2).End(xlUp).Row + 2
If lngNext < 13 Then lngNext = 13
.Cells(lngNext, 4) = ""
lngNext = lngNext + 1
.Cells(lngNext, 2) = CLng(TextBox1)
.Cells(lngNext, 3) = CLng(TextBox2)
.Cells(lngNext, 5) = "=" & TextBox3 & "="
.Cells(lngNext + 1, 5) = ":" & UCase(Replace(TextBox4, ":", "")) & ":"
.Cells(lngNext + 1, 6) = "(" & Replace(Replace(TextBox5, "(", ""), ")", "") & ")"
.Cells(lngNext, 8) = TextBox6.Text
.Cells(lngNext, 9) = CLng(TextBox7)
.Cells(lngNext + 2, 4) = "ENDE " & Replace(TextBox8, "ENDE ", "")
For intIndex = 1 To 8
Controls("TextBox" & intIndex).Value = ""
Next
TextBox2 = Format(Application.Max(.Range("C14:C100")) + 1, "00")
End With
End Sub


Private Sub Label8_Click()
End Sub


Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox5_Change()
End Sub


Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub


Private Sub TextBox8_Change()
End Sub


Private Sub UserForm_Activate()
Dim varList As Variant
varList = Array("BK", "L", "STK", "PKG", "KG")
TextBox1.Value = 33
TextBox2 = Format(Application.Max(Sheets("VVC 33").Range("C14:C100")) + 1, "00")
TextBox6.List = varList
TextBox8 = "ENDE " & Mid(Worksheets("Grunddaten").Range("F9"), 1, _
Len(Worksheets("Grunddaten").Range("F9")) - 0)
End Sub

--------------
LG Maria
Anzeige
AW: Codeänderung bei UF
11.08.2006 16:34:53
fcs
Hallo Maria,
du hattest in der falschen For-Next-Schleife geändert. Hier nochmal der ganze Code. Ich hab mal die Subs rausgeworfen, die nichts machen.
Gruß
Franz

Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim lngNext As Long
Dim intIndex As Integer
For intIndex = 1 To 8  '########### Diese Zeile muß so bleiben
If Len(Controls("TextBox" & intIndex).Value) = 0 Then
MsgBox "Es fehlen noch Angaben!", vbInformation, "Hinweis"
Controls("TextBox" & intIndex).SetFocus
Exit Sub
End If
Next
With Sheets("VVC 33")
lngNext = .Cells(101, 2).End(xlUp).Row + 2
If lngNext < 13 Then lngNext = 13
.Cells(lngNext, 4) = ""
lngNext = lngNext + 1
.Cells(lngNext, 2) = CLng(TextBox1)
.Cells(lngNext, 3) = CLng(TextBox2)
.Cells(lngNext, 5) = "=" & TextBox3 & "="
.Cells(lngNext + 1, 5) = ":" & UCase(Replace(TextBox4, ":", "")) & ":"
.Cells(lngNext + 1, 6) = "(" & Replace(Replace(TextBox5, "(", ""), ")", "") & ")"
.Cells(lngNext, 8) = TextBox6.Text
.Cells(lngNext, 9) = CLng(TextBox7)
.Cells(lngNext + 2, 4) = "ENDE " & Replace(TextBox8, "ENDE ", "")
For intIndex = 2 To 7 '####### Diese Schleife solltest du ändern
Controls("TextBox" & intIndex).Value = ""
Next
TextBox2 = Format(Application.Max(.Range("C14:C100")) + 1, "00")
End With
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub UserForm_Activate()
Dim varList As Variant
varList = Array("BK", "L", "STK", "PKG", "KG")
TextBox1.Value = 33
TextBox2 = Format(Application.Max(Sheets("VVC 33").Range("C14:C100")) + 1, "00")
TextBox6.List = varList
TextBox8 = "ENDE " & Mid(Worksheets("Grunddaten").Range("F9"), 1, _
Len(Worksheets("Grunddaten").Range("F9")) - 0)
End Sub

Anzeige
AW: @fcs
11.08.2006 16:18:13
Maria
Hallo,
ich bin jetzt durch Zufall selber drauf gekommen, etwas weiter unten steht ja noch einmal die gleiche Zeile, die habe ich geändert und es funzt jetzt.
Ich Danke dir und wünsche ein schönes Wochenende.
LG Maria

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige