VBA Macro stop

[grenona2020]

Hi

I have a windows task job that start excel workbook and execute some function in a private open workbook() .

I would like to have a message on the screen when workbook open saying (press space bar or any key to stop execution) , that one look sample,

but i need a loop or something to continue if NO KEY are press after let day 10 sec.

Yes , i could use ctrl break, i need a more friendly way

thanks

 

[Kenneth Hobson]

Welcome to the forum!

I use auto_open in a Module to show a WScript popup msgbox. This waits for a response for a set time. If none, it can do things and then close the workbook.

' http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
' archived at, https://web.archive.org/web/20140320204049/http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
Sub Auto_Open()
  Dim rc As Integer
  rc = MsgBoxWait("No or timing out, Runs Auto Macro(s) and closes workbook.", "Abort? " & _
    "Yes abort running macro and does not close workbook.", 4 + 32, 5)
  '6=Yes, 7=No, -1=timed out
  Select Case rc
    Case 7, -1  'No or times out, ~5 seconds.
      'AddRunNumberDateToColsAB
      ThisWorkbook.Close True
    Case Else '6=Yes, Abort, do not run macros.
  End Select
End Sub

Sub AddRunNumberDateToColsAB()
  Dim r As Range, d As Date, calc As Integer
  d = Now
  
  On Error GoTo EndSub
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  calc = Application.Calculation
  Application.Calculation = xlCalculationManual
  
  Set r = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Offset(1)
  r.Value = WorksheetFunction.Max(r.Columns.EntireColumn) + 1
  r.Offset(, 1).Value = d
  
EndSub:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = calc
End Sub

Sub Hi()
  MsgBox "Hi"
End Sub

 

[grenona2020]

Welcome to the forum!

I use auto_open in a Module to show a WScript popup msgbox. This waits for a response for a set time. If none, it can do things and then close the workbook.

' http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
' archived at, https://web.archive.org/web/20140320204049/http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
Sub Auto_Open()
  Dim rc As Integer
  rc = MsgBoxWait("No or timing out, Runs Auto Macro(s) and closes workbook.", "Abort? " & _
    "Yes abort running macro and does not close workbook.", 4 + 32, 5)
  '6=Yes, 7=No, -1=timed out
  Select Case rc
    Case 7, -1  'No or times out, ~5 seconds.
      'AddRunNumberDateToColsAB
      ThisWorkbook.Close True
    Case Else '6=Yes, Abort, do not run macros.
  End Select
End Sub

Sub AddRunNumberDateToColsAB()
  Dim r As Range, d As Date, calc As Integer
  d = Now
 
  On Error GoTo EndSub
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  calc = Application.Calculation
  Application.Calculation = xlCalculationManual
 
  Set r = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Offset(1)
  r.Value = WorksheetFunction.Max(r.Columns.EntireColumn) + 1
  r.Offset(, 1).Value = d
 
EndSub:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = calc
End Sub

Sub Hi()
  MsgBox "Hi"
End Sub

Hi

i'm getting compile error

 

[Kenneth Hobson]

Sorry, that was in another module. Both can be in the same Module. You can send a nSecondsToWait value other -1 if you want seconds to wait. -1 is infinite wait.

You can remove the AddRunNumberDateToColsAB(). I used that for logging opens.

Sub Auto_Open()
  Dim rc As Integer
  rc = MsgBoxWait("No or timing out, Runs Auto Macro(s) and closes workbook.", "Abort? " & _
    "Yes abort running macro and does not close workbook.", 4 + 32, 5)
  '6=Yes, 7=No, -1=timed out
  Select Case rc
    Case 7, -1  'No or times out, ~5 seconds.
      Hi  'Do whatever here and then save and close thisworkbook...
      ThisWorkbook.Close True
    Case Else '6=Yes, Abort, do not run macros.
  End Select
End Sub

Sub Hi()
  MsgBox "Hi"
End Sub

Function MsgBoxWait(strTitle As String, strText As String, _
    nType As Integer, Optional nSecondsToWait As Integer = -1) As Integer
  Dim ws As Object, rc As Long
  Set ws = CreateObject("WScript.Shell")
  'intButton = object.Popup(strText,[nSecondsToWait],[strTitle],[nType])
  rc = ws.Popup(strText, nSecondsToWait, strTitle, nType)
  Set ws = Nothing
  MsgBoxWait = rc
End Function

 

[grenona2020]

Welcome to the forum!

I use auto_open in a Module to show a WScript popup msgbox. This waits for a response for a set time. If none, it can do things and then close the workbook.

' http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
' archived at, https://web.archive.org/web/20140320204049/http://office.microsoft.com/en-us/excel-help/running-a-macro-when-excel-starts-HA001034628.aspx
Sub Auto_Open()
  Dim rc As Integer
  rc = MsgBoxWait("No or timing out, Runs Auto Macro(s) and closes workbook.", "Abort? " & _
    "Yes abort running macro and does not close workbook.", 4 + 32, 5)
  '6=Yes, 7=No, -1=timed out
  Select Case rc
    Case 7, -1  'No or times out, ~5 seconds.
      'AddRunNumberDateToColsAB
      ThisWorkbook.Close True
    Case Else '6=Yes, Abort, do not run macros.
  End Select
End Sub

Sub AddRunNumberDateToColsAB()
  Dim r As Range, d As Date, calc As Integer
  d = Now
 
  On Error GoTo EndSub
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  calc = Application.Calculation
  Application.Calculation = xlCalculationManual
 
  Set r = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Offset(1)
  r.Value = WorksheetFunction.Max(r.Columns.EntireColumn) + 1
  r.Offset(, 1).Value = d
 
EndSub:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = calc
End Sub

Sub Hi()
  MsgBox "Hi"
End Sub

Hi

Thanks very munch, it work the way i like.