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 |
|