Nachtrag: Code ohne Datei
31.01.2018 10:55:10
Peter(silie)
Hallo,
hier noch der Userform Code für die Download faulen:
Option Explicit
Private Sub UserForm_Terminate()
SheetProtection True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
SheetProtection True
End Sub
Private Sub UserForm_Initialize()
SheetProtection True
End Sub
Private Sub btn_abort_Click()
'Protect the worksheet!
SheetProtection
MsgBox "Das bearbeiten dieser Datei ist erst nach Eingabe der Daten möglich!", vbOKOnly, "! _
ACHTUNG!"
End Sub
Private Sub SheetProtection(Optional ByVal Enabled As Boolean = True)
If Enabled Then
ThisWorkbook.Sheets("Kalkulation").Protect "Blattspinat"
Else
ThisWorkbook.Sheets("Kalkulation").Unprotect "Blattspinat"
End If
End Sub
Private Sub btn_confirmed_Click()
If ValidInputs Then
With ThisWorkbook.Sheets("Kalkulation")
'Remove worksheet protection!
SheetProtection False
'Add Data
.Cells(1, 3).Value = tb_ProjectInput.Value
.Cells(1, 6).Value = tb_ClientInput.Value
Unload Me
End With
Else
'Show User that the input isnt correct
ControlBlink
End If
End Sub
Private Sub tb_ClientInput_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub tb_ProjectInput_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
End Sub
Private Function ValidInputs() As Boolean
Dim inp1 As String, inp2 As String
inp1 = tb_ProjectInput.Value
inp2 = tb_ClientInput.Value
If Not inp1 = vbNullString And Not inp2 = vbNullString Then
If Len(inp1) = 8 And Len(inp2) = 5 Then
ValidInputs = True
End If
End If
End Function
Private Sub ControlBlink()
Dim color1(1) As Long
Dim blink As Boolean
Dim t As Double
Dim i As Long
Const TIME As Double = 0.08
On Error Resume Next
color1(0) = 255
color1(1) = 125
Do
blink = Not blink
tb_ClientInput.BackColor = color1(-blink)
tb_ProjectInput.BackColor = color1(-blink)
t = Timer + TIME
Do While Timer 5
tb_ClientInput.BackColor = vbWhite
tb_ProjectInput.BackColor = vbWhite
End Sub