AW: InputBox Eingaben ansagen geht so nicht
27.01.2023 13:08:12
volti
Hallo Dieter,
Du kannst die Rückgabevariablen für eine Inputbox nicht als Integer deklarieren. Sie müssen schon String oder Variant sein.
Wenn Du später unbedingt eine Zahl benötigt, kannst Du diese ja per Val(Sys) umrechnen.
Code:
Sub MessWerte() 'Sys- und Pulswerte Eingabe per Inbutbox
Dim Zelle As Range
If MsgBox(" Werte eingeben?", vbYesNo + vbDefaultButton2, " Pulsoximeter") = vbYes Then
Application.ScreenUpdating = False
Dim lngLast1 As Long 'Bereich D11:D72
Dim lngLast2 As Long 'Bereich E11:E72
Dim Sys As String, Puls As String
lngLast1 = Cells(Rows.Count, 4).End(xlUp).Row + 1
lngLast2 = Cells(Rows.Count, 5).End(xlUp).Row + 1
If lngLast1 > 72 Or lngLast2 > 72 Then
MsgBox "Bereich schon voll!", , "Eingabe"
Else
Application.Speech.Speak ("Abendwerte"), SpeakAsync:=True
Sys = Application.InputBox("Sys Wert?", Format(Date, "ddd dd.mm.yyyy"))
If Sys <> "" Then Application.Speech.Speak "Eingegebener Wert für Sys ist " & Sys
Puls = Application.InputBox("Puls Wert?", Format(Date, "ddd dd.mm.yyyy"))
If Puls <> "" Then Application.Speech.Speak "Eingegebener Wert für Puls ist " & Puls
Range("D" & lngLast1).Value = Sys 'Bereich D11:D72
Range("E" & lngLast2).Value = Puls 'Bereich E11:E72
End If
'2ter Lauf, für Eingabe von 2*2 Zellen in D und E_
'hintereinander zu ermöglichen
lngLast1 = Cells(Rows.Count, 4).End(xlUp).Row + 1
lngLast2 = Cells(Rows.Count, 5).End(xlUp).Row + 1
If lngLast1 > 72 Or lngLast2 > 72 Then
MsgBox "Bereich schon voll!", , "Eingabe"
Else
Application.Speech.Speak ("Morgenwerte"), SpeakAsync:=True
Sys = Application.InputBox("2. Sys Wert?")
If Sys <> "" Then Application.Speech.Speak "Eingegebener Wert für Sys ist " & Sys
Puls = Application.InputBox("2. Puls Wert?")
If Puls <> "" Then Application.Speech.Speak "Eingegebener Wert für Puls ist " & Puls
Range("D" & lngLast1).Value = Sys 'Bereich D11:D72
Range("E" & lngLast2).Value = Puls 'Bereich E11:E72
End If
Application.Speech.Speak ("Jetzt Daten Button klicken"), SpeakAsync:=True
ActiveWindow.ScrollRow = 1
'Im Bereich die Null löschen
'Null durch InputBox Abbruch bedingt
'Sub Raus_Null()
Dim rng As Range
For Each rng In Range("D11:E72")
If rng.Value = 0 Then rng.ClearContents
Next
'Löschen der Zwischenablage
Application.CutCopyMode = False
End If
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz