habe derzeit ein ziemlich großes "Projekt" am Laufen und deshalb in den letzten Tagen immer mal wieder Hilfe gesucht (und meistens hier auch gefunden).
Problem - ich kann die Mappe zur Anschauung nicht hochladen!
Und genau danach wurde in den letzten Tagen eigentlich immer gefragt...
Ich kann das natürlich nachvollziehen, dass ihr das gerne sehen wollt um mein Problem zu verstehen. Aber wenn ich das machen wollte, dann würde ich ungelogen einen halben Tag davor sitzen um die Mappe wieder zu entfremden, da wirklich massenhaft vertrauliche Inhalte drin sind. Und das möchte ich mir gerne sparen.
Also - wen jemand die Muße hat sich mein Problem mal anzuschauen - ich beschreibe das so gut ich kann:
In dem Worksheet_Change des Blattes "Datenerfassung" mache ich neben ganz vielen anderen Sachen unter anderem das hier:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CellsGeb As Range
Dim Alter As Date
Set CellsGeb = Range("Y25, AD25, AN26, AN27, AN28")
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'Altersprüfung bei den Kindern:
If Not Intersect(CellsGeb, Target) Is Nothing Then
'In Offset(10, 0) wird per Formel die Altersdifferenz ermittelt
'In Offset(10, 1) wird per Formel ermittelt ob alle anderen Angaben zu dem jeweiligen Kind _
gemacht wurden (wenn 1 Eintrag enthalten, dann ist das Formelergebnis "Eintrag")
If Not IsEmpty(Target) And Target.Offset(10, 1).Value = "Eintrag" Then
Alter = Target.Offset(10, 0).Value + 1
If Format(Alter, "d") >= 20 Then
MsgBox "Der xxxxxx ist bei Posteingang bereits " & Format(Alter, "d") & " Jahre _
alt! Sind Sie sicher?", vbOKOnly, "Achtung!"
End If
End If
End If
Set CellsGeb = Nothing
End Sub
Was soll das Ganze?Ich habe 5 Bereiche für die Eintragungen von Kindern nebst ihrem Geburtstag. Dazu habe ich die 5 Geburtstage als CellsGeb deklariert. Wenn das Alter des Kindes >= 20, dann kommt die MsgBox als Hinweis.
Klappt auch wunderbar.
Nun mache ich aber zwingend (!!) im Workbook_BeforeClose alle ausgefüllten Zellen auf diesem Blatt mit einem anderen Makro CellsEmpty wieder leer - unter anderem auch die Geburtstage.
Das Makro dazu ist:
Sub CellsEmpty()
Application.ScreenUpdating = False
Sheets("Datenerfassung").Activate
Call Protect_off
'alle Eingaben wieder löschen
Dim rngZelle As Range, CellsEmpty As Range
Set CellsEmpty = Sheets("Datenerfassung").Range("Y11, BG25, AD19, AD25, AC17, AC21, AC23, BB9, BB11, BB13, BB15, BB17, BB19, BB21, BB23, BB25, BF9, BF11, BF14, Y7, Y9, Y19, Y25, X17, X21, X23, AL9:AM9, AL11:AM11, AQ9, AQ11, AQ17, AQ19:AR19, AQ21:AR21, AQ26:AQ28, AS26:AS28, AL17, AL19:AM19, AL21:AM21")
If Not CellsEmpty.MergeCells Then
CellsEmpty.ClearContents
Else
For Each rngZelle In CellsEmpty
rngZelle.MergeArea.ClearContents
Next
End If
Set CellsEmpty = Nothing
'das hier geht irgendwie nicht mehr rein oben ins CellsEmpty, keine Ahnung wieso
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Range("AL26:AN28").ClearContents
Call Protect_on
Sheets("Aktenvermerk").Activate
Call Protect_off
Sheets("Aktenvermerk").Range("D40").ClearContents
Call Protect_on
Sheets("Datenerfassung").Activate
Application.ScreenUpdating = True
End Sub
Nun zeigt er mir bevor die Speicherabfrage kommt einen Laufzeitfehler 13, Typen unverträglich
und zwar hier:
If Not IsEmpty(Target) And Target.Offset(10, 1).Value = "Eintrag" Then
Kann jemand erkennen wo ich die Prozedur falsch gebaut habe? Scheint mir ein grundsätzliches Problem zu sein....
Hinweis:
Die Berechnung zu
If Format(Alter, "d") >= 20
mag etwas seltsam aussehen, ich hab's nicht anders hinbekommen da ich mir in diesen Zellen stets das Alter als Ganzzahl ausrechne und dabei natürlich die Datumsangaben verwende... da hat's mir im VBA Code bei einem 21-jährigen Kind als Ergebnis immer 21.01.1900 angezeigt wenn ich nur geprüft habe If Alter >= 20 ...
Der Code läuft aber wie gewünscht, von daher ist mir das wurscht....
Danke an alle die sich das reinziehen wollen!