Re: Mehrfachauswahl
10.12.2002 21:44:51
Harry_W
Hallo PeterDie UserForm
Option Explicit
Private Sub cmdWeiter_Click()
Dim intCounter As Integer
Dim arrItems() As String
Dim intItems As Integer
For intCounter = 0 To lstSheets.ListCount - 1
If lstSheets.Selected(intCounter) Then
intItems = intItems + 1
ReDim Preserve arrItems(1 To intItems)
arrItems(intItems) = lstSheets.List(intCounter)
End If
Next intCounter
If intItems > 0 Then
Worksheets(arrItems).Select
End If
Unload Me
Call Eingabe
End Sub
Private Sub UserForm_Initialize()
Dim shact As Worksheet
For Each shact In ThisWorkbook.Worksheets
If shact.Cells(96, 1) = 12 Then Else GoTo 1
If shact.Visible = True Then
lstSheets.AddItem shact.Name
End If
1:
Next shact
End Sub
Der Code
Sub Eingabe()
5:
Dim Start As Date, z As String
Dim C As Integer, d As Integer
Dim a, b
b = ActiveSheet.Range("G3")
Start = InputBox("Eingabedatum eingeben", , (Date - 1))
C = 6
If Month(Start) = 1 Then d = 6 Else d = 7 * Month(Start) - 1
Do Until Cells(d, C) = Start
On Error GoTo 3
C = C + 1
Loop
a = InputBox("U = Urlaub / K = Krank / S = Sonder /" & Chr(13) & Chr(13) _
& "u.U = unbezahlter Urlaub / N = variabel")
If a = ("U") Or a = ("u") Or a = ("S") Or a = ("s") Or a = ("K") Or a = ("k") Or a = ("u.u") Or a = ("u.U") Or a = ("S") Or a = ("s") Or a = ("N") Or a = ("n") Then Else GoTo 1
If a = ("U") Or a = ("u") Then Cells(d + 1, C) = a
If a = ("K") Or a = ("k") Then Cells(d + 2, C) = a
If a = ("S") Or a = ("s") Then Cells(d + 3, C) = a
If a = ("u.U") Or a = ("u.u") Then Cells(d + 4, C) = a
If a = ("N") Or a = ("n") Then Cells(d + 5, C) = a
GoTo 2
1: MsgBox ("Es wurde Fehlart - ") & a & (" - eingegeben. ") & Chr(13) & Chr(13) & Chr(13) _
& (" Eingabe wird abgebrochen")
GoTo 2
3: MsgBox ("Es wurde das Datum - ") & Start & (" - eingegeben. ") & Chr(13) & Chr(13) & Chr(13) _
& (" Eingabe wird abgebrochen")
2:
If a = ("U") Or a = ("u") Then a = (" Urlaub")
If a = ("K") Or a = ("k") Then a = (" Krank")
If a = ("S") Or a = ("s") Then a = (" Sonderurlaub")
If a = ("u.U") Or a = ("u.u") Then a = (" unbezahlter Urlaub")
If a = ("N") Or a = ("n") Then a = (" variabel")
If MsgBox("Letzter Eintrag " & Chr(13) & Chr(13) & "Mitarbeiter/in :" & b _
& Chr(13) & Chr(13) & "Datum :" & Start _
& Chr(13) & Chr(13) & "Fehlart :" & a _
& Chr(13) & Chr(13) & "Neuer Eintrag bei diesem/r Mitarbeiter/in ? ", vbYesNo, " INFO") = vbYes Then GoTo 5
Sheets("Namensübersicht").Select
Application.ScreenUpdating = True
End Sub
Die Ausgewählten Blätter sind Kalender.
mfg
Harry_W