Brauche doch noch eine kleine Hilfe
20.10.2010 15:56:03
Deister
Hallo Erich,
Ich habe den Code noch ein wenig ausgebaut und sitze wieder auf dem Schlauch.
Bei den Blättern "database 1 bis 10" handelt es sich um versteckte Blätter in welchen ich 3 verschiedene Daten pflegen muss. Die erste lehre Zelle bekomme ich gepflegt, die zweite R[-1]C[+1] und anschliessend die dritte R[-1]C[0], bekomme ich nicht hin.
Mein problem liegt bei
Range("R[-1]C[+1]") = Wert2
respektif bei
Range("R[-1]C[0]") = Wert3
Anbei der ganze Code, so wie er bis zur Fehlermeldung läuft:
Option Explicit
Sub ErsteFreie4B()
If Range("E6") 1 Then
MsgBox ("Sie haben keine Berechtigung um diese Daten zu pflegen." & Chr$(10) _
& "Vous n'avez pas d'autorisation pour soigner ces données.")
Exit Sub
Else
Dim nn As Long, rngFrei As Range
For nn = 1 To 10
With Sheets("database " & nn)
Set rngFrei = ErsteFreie4Fkt(.Rows(1))
If Not rngFrei Is Nothing Then
.Activate
rngFrei.Select
Exit For
End If
End With
Next nn
End If
Dim Wert1$
Wert1 = InputBox("Bitte geben Sie den Namen des neuen Mitarbeiters ein!" & Chr$(10) _
& "Veuillez entrer le nom du nouveau collaborateur!", "Personaldaten / Données du personnel" _
)
ActiveCell.Value = Wert1
Dim Wert2$
Wert2 = InputBox("Bitte geben Sie die Personalnummer ein!" & Chr$(10) _
& "Veuillez entrer son numéro du personnel!", "Personaldaten / Données du personnel")
Range("R[-1]C[+1]") = Wert2
Dim Wert3$
Wert3 = InputBox("Bitte geben Sie den Geburtstag ein!" & Chr$(10) _
& "Bitte / als Trennung benutzen" & Chr$(10) _
& "Tag/Monat/Jahr" & Chr$(10) _
& "" & Chr$(10) _
& "Veuillez entrer la date de naissance!" & Chr$(10) _
& "Utilisez / comme séparateur" & Chr$(10) _
& "Jour/Mois/Année", "Personaldaten / Données du personnel")
Range("R[-1]C[0]") = Wert3
End Sub
Function ErsteFreie4Fkt(rngR As Range) As Range
Dim arrW, cc As Long
arrW = rngR.Value
For cc = 1 To rngR.Columns.Count Step 4
If IsEmpty(arrW(1, cc)) Then
Set ErsteFreie4Fkt = rngR.Cells(cc)
Exit For
End If
Next cc
End Function