InputBox

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ZEIT EINFÜGEN() Range("R11").Value = InputBox("Geben Sie Ihre Soll Zeit ein! Beispiel: 8:00 (proTag)", "Eingabeformular", "8:00") Range("R11").Select'kopiert den wert runter Selection.Copy Range("R12:R41").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False ActiveWindow.SmallScroll Down:=-30 Application.CutCopyMode = False End Sub

Option Explicit 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:R42") .NumberFormat = "[h]:mm" .Value = antwort End With End Sub

Private Sub ControlEnableDisable(intId As Integer, bolStatus As Boolean) Dim Steuerelement As CommandBarControl, SuchBar As CommandBar On Error Resume Next For Each SuchBar In Application.CommandBars Set Steuerelement = SuchBar.FindControl(ID:=intId, Recursive:=True) If Not Steuerelement Is Nothing Then Steuerelement.Enabled = bolStatus Next End Sub

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

Hallo Karli,
da sind aber ein paar Ungereimtheiten drin.

1. Application.ScreenUpdating = False - bewirkt, dass der Bildschirm nicht aktualisiert wird. Verschieb mal deine Userform und schau was dabei passiert.

2. On Error Resume Next - bewirkt, dass bei einem Programmfehler das Programm in der nächsten Zeile weitermacht. Aber der Rest der Anweisungen:
If Err.Number <> 0 Then
Exit Sub
End If
ist Unsinn, da nach der On Error-Anweisung noch kein Fehler passiert sein kann.

3. Du deklarierst deine Variablen nicht, dass heißt, jede Variable hat den Datentyp Variant und benötigt daher 1. relativ viel Speicher und 2. müssen die Variablen jedes mal beim zuweisen an eine Eigenschaft automatisch konvertiert werden, was nicht gerade sehr schnell geht 3. wenn du dich bei einem Variablennamen einmal verschreibst, kannst du lange (ich habe Programme mit mehreren hundert Zeilen) suchen, wo der Fehler herrührt.

4. ActiveCell.Select - eine aktive Zelle ist schon selektiert.

5. AnzahlBlätter = Sheets.Count - wenn du diese Variable sowieso nur einmal benutzt, dann kannst du auch - Sheets("Leeres Muster").Copy After:=Sheets(Sheets.Count) schreiben. Das spart schon wieder eine Zuweisung und damit Speicherplatz und Zeit.

6. Du machst keinerlei Prüfung was der User als Blattnamen eingibt und ob dieses Blatt nicht schon existiert.

Ich benötige, um dir die Comboboxen in deine Userform einzubauen die Userform. Also die Userform exportieren und mir schicken (kaffl-nuernberg@t-online.de). Es müssen zwei Dateien sein, eine mit der Dateiendung .frm und eine mit .frx. Und wie war das mit der Zelle K3 in der der Name für die Kopie der Tabelle "Leeres Muster" steht? Davon sehe ich gar nichts in deinem Code.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread