Re: WorkbookClose
29.05.2003 08:35:09
dan
Hallo Dierk,
ich habe deine frage gelesen. ich habe makro, was einbischen ehnlich arbeitet und moglicher weise wird es dir helfen.
Wie es functioniert : wenn man den workbook schliesen will, sucht das makro in allen zellen des activesheets nach allen zellen, die das aktuelle datum beinhalten. wenn gefunden, dann testet makro alle zellen, die an der linken seite von der zelle mit dem datum liegen. wenn findet zelle, die leer ist, wird der workbook nicht geschlossen.... ob das makro was findet hangt stark davon ab, wie sind die zellen mit dem datum formatiert und ob das datum ein wert ist oder ergebnis einer formel. falls du es probieren mochtest, kopiere den folgenden code in den class modul von workbook, wo man die event workbook_beforeclose ansprechen kann. falls du dazu fragen hast, dann schreib mir. mfg aus der tschechischen rep. dan.
-------------------------------------------------
Option ExplicitPrivate rData As Range, rDatum As Range
Private dGesDate As Date, rNichtAusgefullt As Range
Private iCol As Integer, iRow As Integer
Private firstAddress As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set rNichtAusgefullt = Nothing
Set rData = ActiveSheet.Cells
rData.Interior.ColorIndex = xlNone
dGesDate = Date
Set rDatum = rData.Find(what:=dGesDate, LookIn:=xlFormulas, lookat:=xlWhole)
If Not rDatum Is Nothing Then
firstAddress = rDatum.Address
Do
If Not Ausgefullt Then
If Not rNichtAusgefullt Is Nothing Then
Set rNichtAusgefullt = Application.Union(rNichtAusgefullt, rDatum)
Else
Set rNichtAusgefullt = rDatum
End If
End If
Set rDatum = rData.FindNext(rDatum)
Loop While Not rDatum Is Nothing And rDatum.Address <> firstAddress
End If
If Not rNichtAusgefullt Is Nothing Then
Cancel = True
MsgBox "Heutige Daten nicht vollstandig ausgefullt."
rNichtAusgefullt.Interior.ColorIndex = 3
End If
End Sub
Private Function Ausgefullt() As Boolean
On Error Resume Next
Ausgefullt = True
iCol = rDatum.Column - 1
Do While iCol >= 1
If Cells(rDatum.Row, iCol).Value = "" Then
Ausgefullt = False
Exit Function
End If
iCol = iCol - 1
Loop
End Function