Ken5000
03-04-2011, 05:36 AM
I originally asked for a good solid timer to save and close my workbook.
mdmackillop recommended this by Paleo
' ----- This goes to the This_Workbook
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call Timer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call Timer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Limpa
End Sub
' ----- This goes to the Module
Public vartimer As Variant
Sub Timer()
Call Limpa
vartimer = Format(Now + TimeSerial(0, 30, 0), "hh:mm:ss")
If vartimer = "" Then Exit Sub
Application.OnTime TimeValue(vartimer), "Fecha"
End Sub
Sub Fecha()
With Application
.EnableEvents = False
ActiveWorkbook.Save
.Quit
End With
End Sub
Sub Limpa()
On Error Resume Next
Application.OnTime earliesttime:=vartimer, _
procedure:="Fecha", schedule:=False
On Error Goto 0
End Sub
(Sorry I cannot yet post links)
and up until I ran this print macro all was perfectly fine .
Sub PrintNames_Daily_Clinical_Front_Side()
'
' PrintNames_Daily_Clinical_Front_Side Macro
'
'
Application.ScreenUpdating = False
CopyStatesButen 'Sorts
Sort_32 'Sorts other suff
Sheets("Daily Clinical Review").Select 'Selects the sheet
Dim sh1 As Worksheet
Dim r1 As Range, cell As Range
Dim cnt As Long, cnt1 As Long
Set sh1 = Worksheets("Daily Clinical Review") 'Name of Sheet
ActiveSheet.PageSetup.PrintArea = "$AA$7:$AT$39"
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25) 'Page Steup
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = 98
End With
cnt = Application.CountIf(sh1.Range("W8:W39"), 1) 'Range has the numbar 1 if there is a name to print.
Set r1 = sh1.Range("U8:U39") 'Where the 2 names come from
cnt1 = 0
For Each cell In r1
cnt1 = cnt1 + 1
If cnt1 > cnt Then Exit For
sh1.Range("AB9").Value = cell 'Where the firs name goes
sh1.Range("AF9").Value = cell.Offset(0, 1) 'Where the second name goes
sh1.Range("$AA$7:$AT$39").PrintOut 'Size of the form
Next
Sheets("Daily Clinical Review").Select 'So that you set focus
Application.ScreenUpdating = True
Range("I1").Select 'Whare you should be when completed
End Sub
:dunno
Since I'm not quite getting a handle on this time code , could someone make suggestions that might reset the timer while using this macro.
The macro takes a long time to run, longer than the timeout that I have set for 4min & 30se.
Thanks
mdmackillop recommended this by Paleo
' ----- This goes to the This_Workbook
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call Timer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call Timer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Limpa
End Sub
' ----- This goes to the Module
Public vartimer As Variant
Sub Timer()
Call Limpa
vartimer = Format(Now + TimeSerial(0, 30, 0), "hh:mm:ss")
If vartimer = "" Then Exit Sub
Application.OnTime TimeValue(vartimer), "Fecha"
End Sub
Sub Fecha()
With Application
.EnableEvents = False
ActiveWorkbook.Save
.Quit
End With
End Sub
Sub Limpa()
On Error Resume Next
Application.OnTime earliesttime:=vartimer, _
procedure:="Fecha", schedule:=False
On Error Goto 0
End Sub
(Sorry I cannot yet post links)
and up until I ran this print macro all was perfectly fine .
Sub PrintNames_Daily_Clinical_Front_Side()
'
' PrintNames_Daily_Clinical_Front_Side Macro
'
'
Application.ScreenUpdating = False
CopyStatesButen 'Sorts
Sort_32 'Sorts other suff
Sheets("Daily Clinical Review").Select 'Selects the sheet
Dim sh1 As Worksheet
Dim r1 As Range, cell As Range
Dim cnt As Long, cnt1 As Long
Set sh1 = Worksheets("Daily Clinical Review") 'Name of Sheet
ActiveSheet.PageSetup.PrintArea = "$AA$7:$AT$39"
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25) 'Page Steup
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = 98
End With
cnt = Application.CountIf(sh1.Range("W8:W39"), 1) 'Range has the numbar 1 if there is a name to print.
Set r1 = sh1.Range("U8:U39") 'Where the 2 names come from
cnt1 = 0
For Each cell In r1
cnt1 = cnt1 + 1
If cnt1 > cnt Then Exit For
sh1.Range("AB9").Value = cell 'Where the firs name goes
sh1.Range("AF9").Value = cell.Offset(0, 1) 'Where the second name goes
sh1.Range("$AA$7:$AT$39").PrintOut 'Size of the form
Next
Sheets("Daily Clinical Review").Select 'So that you set focus
Application.ScreenUpdating = True
Range("I1").Select 'Whare you should be when completed
End Sub
:dunno
Since I'm not quite getting a handle on this time code , could someone make suggestions that might reset the timer while using this macro.
The macro takes a long time to run, longer than the timeout that I have set for 4min & 30se.
Thanks