AW: Zu Teil 1 in tabelle schreiben
28.09.2003 09:18:28
karli
HI NEPUMUK
SUPER JETZT HAB ICH ES ENDECKT GENAU DAS BRAUCH ICH!
nur hätte ich diese auswahlfenster lieber in der userform1
geht das??
HIER MEIN CODE (leider sehr schlampig)
'Option Explicit
Sub neuesBlatt()
Application.ScreenUpdating = False
'Dim AnzahlBlätter As String
'Dim Blattname As String
On Error Resume Next
If Err.Number <> 0 Then
Exit Sub
End If
AnzahlBlätter = Sheets.Count
Blattname = InputBox("Bravo gut gemacht !Sie erstellen jetzt ein neues Monat. Geben Sie einen Namen des Monates ein und danach das Jahr! Beispiel : Okt.03", _
"Neues Blatt erstellen")
If Blattname = "" Then
ActiveCell.Select
Else
Sheets("Leeres Muster").Copy After:=Sheets(AnzahlBlätter)
With ActiveSheet
.Visible = True 'kopiertes Blatt sichtbar machen
.Name = Blattname 'Name zuweisen
'.Unprotect 'Blattschutz aufheben anbieten
End With
End If
Call eingabe
Range("B11").Select
Unload UserForm1
Application.ScreenUpdating = True
End Sub
Public
Sub eingabe()
Dim antwort As String, index As Integer, falsch As Boolean
Do
antwort = InputBox("Geben Sie Ihre Sollzeit ein! Beispiel: 8:00 (pro Tag)", "Eingabe")
antwort = Trim(antwort)
For index = 1 To Len(antwort)
If Not IsNumeric(Mid(antwort, index, 1)) Then Mid(antwort, index, 1) = ":"
Next
If InStr(1, antwort, ":") = 0 Then antwort = antwort & ":00"
If Len(Mid(antwort, InStr(1, antwort, ":") + 1)) = 0 Then antwort = antwort & "00"
If Len(Mid(antwort, InStr(1, antwort, ":") + 1)) = 1 Then antwort = antwort & "0"
If Not IsNumeric(Mid(antwort, 1, InStr(1, antwort, ":") - 1)) Then antwort = 0 & antwort
If Len(Mid(antwort, InStr(1, antwort, ":") + 1)) > 2 Then falsch = True
If Len(Mid(antwort, 1, InStr(1, antwort, ":") - 1)) = 0 Or Len(Mid(antwort, 1, InStr(1, antwort, ":") - 1)) > 2 Then falsch = True
If InStr(InStr(antwort, ":") + 1, antwort, ":") <> 0 Then falsch = True
If IsNumeric(Mid(antwort, InStr(1, antwort, ":") + 1)) Then
If CDbl(Mid(antwort, InStr(1, antwort, ":") + 1)) > 59 Then falsch = True
Else
falsch = True
End If
If Not falsch Then If CDbl(Mid(antwort, 1, InStr(1, antwort, ":") - 1)) = 0 And CDbl(Mid(antwort, InStr(1, antwort, ":") + 1)) = 0 Then falsch = True
If Not falsch Then Exit Do
MsgBox "Ihre Eingabe hatte nicht das richtige Format," & vbNewLine & "oder es wurde eine ungültige Zeitangabe gemacht.", 48, "Hinweis"
falsch = False
Loop
With ActiveSheet.Range("R11:R41")
.NumberFormat = "[h]:mm"
.Value = antwort
End With
End Sub
danke karli