danovkos
05-27-2009, 03:43 AM
Hi all,
pls can you help me. I dont know, what i deleted or what, but this code stops works for me.
It return "Run time error 1004" - Document not saved
and stops on row "ActiveWorkbook.Save"
Private Sub Workbook_Open()
Rem Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Rem newHour = Hour(Now())
Rem newMinute = Minute(Now())
Rem newSecond = Second(Now()) + 5
Rem waitTime = TimeSerial(newHour, newMinute, newSecond)
Dim wBook As Workbook
Dim LCount As Long
Msg = "Spustiť makro na zapísanie príchodu a odchodu???." ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton1 ' Define buttons.
Title = "Dochádzka" ' Define title.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
On Error GoTo 0
If Time < 0.5 Then
Cells(5, "D").Offset(Application.Match(CLng(Date), Range(Cells(6, "D"), Cells(Rows.Count, "D").End(xlUp)), 0)).Select
On Error GoTo 0
ActiveCell.Offset(0, 1).Select
Rem ActiveCell.FormulaR1C1 = "=NOW()-0.003"
Rem toto je 7,30 --- 0.3125
Rem toto je 12,00 --- 0.5
Rem toto je 15,00 --- 0.625
ActiveCell.Value = Time - 0.003
Selection.NumberFormat = "h:mm"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Rem Application.Wait (5000)
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
ElseIf Time > 0.5 Then
On Error GoTo 0
Cells(5, "D").Offset(Application.Match(CLng(Date), Range(Cells(6, "D"), Cells(Rows.Count, "D").End(xlUp)), 0)).Select
ActiveCell.Offset(0, 2).Select
On Error GoTo 0
Rem ActiveCell.FormulaR1C1 = "=NOW()+0.003"
ActiveCell.Value = Time + 0.003
Selection.NumberFormat = "h:mm"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Application.Wait waitTime
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
End If
Application.Wait waitTime
Else ' User chose No.
Exit Sub
End If
Application.Wait waitTime
Rem začiatok exekúcii --------------------------------------------------------------------
End Sub
can you help me with this?
thx
pls can you help me. I dont know, what i deleted or what, but this code stops works for me.
It return "Run time error 1004" - Document not saved
and stops on row "ActiveWorkbook.Save"
Private Sub Workbook_Open()
Rem Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Rem newHour = Hour(Now())
Rem newMinute = Minute(Now())
Rem newSecond = Second(Now()) + 5
Rem waitTime = TimeSerial(newHour, newMinute, newSecond)
Dim wBook As Workbook
Dim LCount As Long
Msg = "Spustiť makro na zapísanie príchodu a odchodu???." ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton1 ' Define buttons.
Title = "Dochádzka" ' Define title.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
On Error GoTo 0
If Time < 0.5 Then
Cells(5, "D").Offset(Application.Match(CLng(Date), Range(Cells(6, "D"), Cells(Rows.Count, "D").End(xlUp)), 0)).Select
On Error GoTo 0
ActiveCell.Offset(0, 1).Select
Rem ActiveCell.FormulaR1C1 = "=NOW()-0.003"
Rem toto je 7,30 --- 0.3125
Rem toto je 12,00 --- 0.5
Rem toto je 15,00 --- 0.625
ActiveCell.Value = Time - 0.003
Selection.NumberFormat = "h:mm"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Rem Application.Wait (5000)
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
ElseIf Time > 0.5 Then
On Error GoTo 0
Cells(5, "D").Offset(Application.Match(CLng(Date), Range(Cells(6, "D"), Cells(Rows.Count, "D").End(xlUp)), 0)).Select
ActiveCell.Offset(0, 2).Select
On Error GoTo 0
Rem ActiveCell.FormulaR1C1 = "=NOW()+0.003"
ActiveCell.Value = Time + 0.003
Selection.NumberFormat = "h:mm"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Application.Wait waitTime
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
End If
Application.Wait waitTime
Else ' User chose No.
Exit Sub
End If
Application.Wait waitTime
Rem začiatok exekúcii --------------------------------------------------------------------
End Sub
can you help me with this?
thx