AW: Listbox in Userform und weitere Themen
10.07.2015 06:24:09
fcs
Hallo Sebastiano,
hier angebpasste Userformcode zur Prüfung der Eingaben und zurücksetzen der Listbox-Auswahl nach Speichern/Anzeige.
zu 2. Per Ziffernwahl 0-9 soll direkt zum Grund gesprungen werden und dieser als oberster Eintrag sichtbar sein.
hierzu müsstest du eine Textbox mit max. Eingabelänge = 1 vorbereiten, die dann bei Eingabe einer Ziffer (Change Ereignis) einen der Einträge 0 bis 9 auf selektiert setzt.
Das Scrollen in der Listbox kann man meines Wissens nicht steuern.
zu 5. Bei Fallabschluss sind die Radiobuttons "JA/NEIN" noch ohne Funktion. "Ja" soll hier immer vorbelegt und der Defaultwert sein.
Dies sind keine Radiobuttons sondern Options-Schaltflächen. Setze für den "Ja"-Button im Eigenschaftenfenster die Eigenschaft "Value" auf True.
Der Text für Grund wird ja jetzt schon zu Beginn des Speichern-Makros zusammengefügt für die CSV ausgabe. Dabei muss als als Trennzeichen ein anderes Zeichen/Text verwendet werden als für die Trennung der Spalten.
Gruß
Franz
Dim STARTZEIT As Date
Private Sub prcResetListbox()
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End Sub
Private Sub OptionButton1_ja_Click()
End Sub
Private Sub FIRMA_Change()
End Sub
Private Sub Freitext_Change()
End Sub
Private Sub KANAL_Change()
STARTZEIT = Now
End Sub
Private Sub SPEICHERN_Click()
Dim strMsgText As String
Dim Grund As String
Dim strCSV1 As String, strCSV2 As String
'NEU: 'Ausgabe des ganzen gewählten Eintrages getrennt mit " | "
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Grund = Grund & IIf(Grund = "", "", " | ") & ListBox1.List(i)
End If
Next
'Ausgabe des ganzen gewählten Eintrages getrennt mit ":"
'Dim Grund As String
'For i = 0 To ListBox1.ListCount - 1
'If ListBox1.Selected(i) = True Then
'Grund = Grund & ListBox1.List(i) & ":"
'End If
'Next
'Prüfung der Pflicht-Eingaben
If TEAM = "" Then strMsgText = strMsgText & vbLf & "Team"
If KANAL = "" Then strMsgText = strMsgText & vbLf & "Eingangskanal/Berater"
If Grund = "" Then strMsgText = strMsgText & vbLf & "mindestens ein Anrufgrund"
If strMsgText "" Then
MsgBox "Folgende Pflichteingaben fehlen:" & vbLf & vbLf & strMsgText, _
vbExclamation, "Prüfung der Pflicht-Eingaben"
Else
'Speicherroutine
y = 2: Pfad = ""
While Sheets("Struktur").Cells(y, 2) ""
If TEAM = Sheets("Struktur").Cells(y, 2) Then Pfad = Sheets("Struktur").Cells(y, 3)
y = y + 1
Wend
If Pfad = "" Then
MsgBox "Für dieses Team konnte kein Ablagepfad gefunden werden!", _
vbCritical, "Schwerer Fehler"
ActiveWorkbook.Saved = True
Application.DisplayAlerts = False
Application.Quit
End If
Pfad = Pfad + "Calllog " + Sheets("Struktur").Range("F1") + ".csv"
Application.ScreenUpdating = False
Sheets("Berater").Select
n = InStr(KANAL, ";")
persnr = Mid(KANAL, n + 2)
beratername = Left(KANAL, n - 1)
Application.Visible = True
Range("f2").Select
While UCase(ActiveCell) UCase(persnr)
ActiveCell.Offset(1, 0).Select
Wend
beraterstatus = ActiveCell.Offset(0, 4)
eintrittsdatum = ActiveCell.Offset(0, 2)
rd = Trim(ActiveCell.Offset(0, -4))
Pfad = Trim(ActiveCell.Offset(0, -2))
Application.Visible = False
'Ausgabe in Direktfenster - Nur zum gucken
'For a% = 0 To ListBox1.ListCount - 1
'Debug.Print ListBox1.List(a%)
'Next a%
'NEU:
'pfad = "C:\TEST.csv"
'NEU! - Ausgabe in CSV
Open Pfad For Append As #1
strCSV1 = CStr(Now) + persnr + ";" + CStr(STARTZEIT) + ";" + CStr(Now) + ";" _
+ FIRMA + ";" + TEAM + ";" + beratername + ";" + persnr + ";" _
+ beraterstatus + ";" + CStr(eintrittsdatum) + ";" + rd + ";" + fad + ";"
strCSV2 = ";" + Freitext + ";" + Grund
If Eins = True Then Print #1, strCSV1 & "Eins" & strCSV2
If Zwei = True Then Print #1, strCSV1 & "Zwei" & strCSV2
If Drei = True Then Print #1, strCSV1 & "Drei" & strCSV2
If Fuenf = True Then Print #1, strCSV1 & "Fuenf" & strCSV2
If Sechs = True Then Print #1, strCSV1 & "Sechs" & strCSV2
If Vier = True Then Print #1, strCSV1 & "Vier" & strCSV2
If Acht = True Then Print #1, strCSV1 & "Acht" & strCSV2
If Sieben = True Then Print #1, strCSV1 & "Sieben" & strCSV2
Close #1
Call UserForm_Initialize
prcResetListbox
ActiveWorkbook.Save
End If
End Sub
Private Sub TEAM_Change()
KANAL.Clear
If TEAM = "" Then Exit Sub
kanalx = 0
If FIRMA = "Firma_A" Then kanalx = 1
If FIRMA = "Firma_B" Then kanalx = 3
If FIRMA = "Firma_C" Then kanalx = 5
If kanalx = 0 Then Exit Sub
For y = 3 To 11000
If Sheets("Config").Cells(y, kanalx + 1) = TEAM Then
If Sheets("Config").Cells(y, kanalx) "" Then _
KANAL.AddItem Sheets("Config").Cells(y, kanalx)
End If
Next
Sheets("Config").Range("I5") = TEAM
End Sub
Private Sub UserForm_Activate()
Call UserForm_Initialize
ListBox1.RowSource = Worksheets("Anrufgrund").Range("A2:A87").Address(External:=True)
prcResetListbox
End Sub
Private Sub UserForm_Initialize()
If Sheets("Struktur").Range("F1") = "" Then
MsgBox "Es wurde keine Firma vorgegeben!", vbCritical, "Kein Start möglich"
ERFASSUNG.Hide
Exit Sub
End If
KANAL.Clear
TEAM.Clear
Freitext = ""
Eins = False
Zwei = False
Drei = False
Fuenf = False
Sechs = False
Vier = False
Acht = False
Sieben = False
FIRMA = Sheets("Struktur").Range("F1")
y = 2
While Sheets("Struktur").Cells(y, 2) ""
If Sheets("Struktur").Range("F1") = Sheets("Struktur").Cells(y, 1) Then _
TEAM.AddItem Sheets("Struktur").Cells(y, 2)
y = y + 1
Wend
TEAM = Sheets("Config").Range("I5")
End Sub
Private Sub SCHLIESSEN_Click()
ERFASSUNG.Hide
Application.Visible = True
End Sub