AW: Daten in einem bestimmten Bereich schreiben
24.02.2019 10:09:19
Sepp
Hallo Michael,
blöder Aufbau mit den Verbundzellen!
Dialog rekFormular
Option Explicit
Private Sub cmdBeenden_Click()
Me.Hide
ActiveWorkbook.Close
End Sub
Private Sub UserForm_Initialize()
rekFormular.txtDatum.Value = Date
End Sub
Private Sub cmdOK_Click()
Dim rng As Range
'ActiveSheet.Unprotect Password:="477"
If Len(txtName) And Len(txtVorname) Then
Set rng = FirstEmptyCell(Range("B18:B35,I18:I35"))
If Not rng Is Nothing Then
rng = CDate(txtDatum)
rng.Offset(0, 1) = txtName
rng.Offset(0, 2 + ((rng.Column = 2) * -1)) = txtVorname
Else
MsgBox "Keine Einträge mehr möglich!"
End If
Else
MsgBox "Bitte Name und Vorname eingeben!"
End If
' ActiveSheet.Protect Password:="477"
End Sub
Private Function FirstEmptyCell(Target As Range, Optional Reverse As Boolean = False, Optional byColumn As Boolean = False) As Range
Dim lngArea As Long, lngFrom As Long, lngTo As Long, lngStep As Long
Dim vntRet As Variant, strRef As String
If Reverse Then
lngFrom = Target.Areas.Count: lngTo = 1: lngStep = -1
Else
lngFrom = 1: lngTo = Target.Areas.Count: lngStep = 1
End If
For lngArea = lngFrom To lngTo Step lngStep
With Target.Areas(lngArea)
strRef = "'" & .Parent.Name & "'!" & .Address
If byColumn Then
vntRet = Evaluate(IIf(Reverse, "MAX", "MIN") & "(IF(" & strRef & "="""",COLUMN(" & strRef & _
")+ROW(" & strRef & ")*10^-6))")
Else
vntRet = Evaluate(IIf(Reverse, "MAX", "MIN") & "(IF(" & strRef & "="""",ROW(" & strRef & _
")+COLUMN(" & strRef & ")*10^-6))")
End If
If Not IsError(vntRet) And vntRet > 0 Then
If byColumn Then
Set FirstEmptyCell = .Cells(CDbl("0," & Split(vntRet, ",")(1)) / 10 ^ -6 - .Rows(1).Row + 1, _
CLng(Split(vntRet, ",")(0)) - .Columns(1).Column + 1)
Else
Set FirstEmptyCell = .Cells(CLng(Split(vntRet, ",")(0)) - .Rows(1).Row + 1, _
CDbl("0," & Split(vntRet, ",")(1)) / 10 ^ -6 - .Columns(1).Column + 1)
End If
End If
End With
If Not FirstEmptyCell Is Nothing Then Exit Function
Next
End Function
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
| Typ | Name | Eigenschaften |
| CommandButton | cmdOK | | Caption: | Übernehmen | | Height: | 23,7 | | Left: | 177 | | TabIndex: | 3 | | Top: | 174 | | Width: | 59,2 |
|
| CommandButton | CmdAbschl | | Caption: | Rekl. Abschliessen | | Height: | 23,7 | | Left: | 303 | | TabIndex: | 5 | | Top: | 174 | | Width: | 75 |
|
| CommandButton | cmdBeenden | | Caption: | Beenden | | Height: | 23,7 | | Left: | 246 | | TabIndex: | 6 | | Top: | 174 | | Width: | 47,35 |
|
| Label | lbl_Komentar | | Caption: | Komentar | | Height: | 17,75 | | Left: | 17,75 | | TabIndex: | 7 | | Top: | 100,7 | | Width : | 71,1 |
|
| Label | lbl_Name | | Caption: | Name | | Height: | 11,85 | | Left: | 17,75 | | TabIndex: | 8 | | Top: | 47,4 | | Width : | 47,4 |
|
| Label | lbl_Vorname | | Caption: | Vorname | | Height: | 11,85 | | Left: | 171,8 | | TabIndex: | 9 | | Top: | 47,4 | | Width : | 47,4 |
|
| Label | lbl_Datum | | Caption: | Datum | | Height: | 11,85 | | Left: | 308,05 | | TabIndex: | 10 | | Top: | 47,4 | | Width : | 47,4 |
|
| TextBox | TextBox1 | | BackColor: | -2147483624 | | BorderStyle: | 1 | | Font: | Verdana | | Height: | 19,15 | | Left: | 53,3 | | SpecialEffect: | 0 | | TabIndex: | 0 | | Text: | Verstanden und zur Kenntnis genomen | | TextAlign: | 2 | | Top: | 11,85 | | Value: | Verstanden und zur Kenntnis genomen | | Width: | 302,1 |
|
| TextBox | txtName | | Height: | 17,75 | | Left: | 17,75 | | Text: | | | Top: | 65,15 | | Width: | 136,25 |
|
| TextBox | txtVorname | | Height: | 17,75 | | Left: | 171,8 | | TabIndex: | 2 | | Text: | | | Top: | 65,15 | | Width: | 106,6 |
|
| TextBox | txtDatum | | Height: | 17,75 | | Left: | 308,05 | | TabIndex: | 4 | | Text: | | | Top: | 65,15 | | Width: | 65,15 |
|
| TextBox | txt_Komentar | | Height: | 35,55 | | Left: | 17,75 | | TabIndex: | 11 | | Text: | | | Top: | 118,5 | | Width: | 361,35 |
|