Thema Datum  Von Nutzer Rating
Antwort
21.09.2017 17:41:42 Alfons
NotSolved
22.09.2017 06:58:15 Gast30061
NotSolved
22.09.2017 08:04:14 Alfons
NotSolved
Blau Excel automatisch schließen
23.09.2017 06:49:00 Gast20082
NotSolved
03.10.2017 16:53:42 Alfons
NotSolved
03.10.2017 18:08:07 Ben
NotSolved
04.10.2017 16:58:31 Gast35240
NotSolved
04.10.2017 17:07:49 Alfons
NotSolved
04.10.2017 19:58:05 Gast54132
NotSolved

Ansicht des Beitrags:
Von:
Gast20082
Datum:
23.09.2017 06:49:00
Views:
667
Rating: Antwort:
  Ja
Thema:
Excel automatisch schließen

Hallo,

ok prima, der erste Punkt lässt sich noch machen, füg dazu wieder den geänderten Code in die drei Module ein, bei den anderen beiden Punkten wird aber die Luft (...zumindest für mich...) dünn, Du könntest versuchen, wenn bei einem Lockscreen VBA nicht mehr läuft, den Task abzuschießen das ginge aber wohl nur mit VB.NET oder VBScript, ebenso löst das Scrollen in Excel leider keine Event aus, könnte man vielleicht allenfalls über VB.NET abgreifen...

' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliSeconds As Long)

Private mobjProgressBar As MSComctlLib.ProgressBar
Private mdtmTime As Date
Private mblnInit As Boolean

Private Sub CommandButton1_Click()
Call Application.OnTime(EarliestTime:=mdtmTime, _
    Procedure:="prcTimer", Schedule:=False)
mblnInit = False
Call Hide
Call Application.OnTime(EarliestTime:=Now + TimeSerial(0, 0, GC_TIME_SEC), _
     Procedure:="prcTimer")
End Sub

Private Sub UserForm_Activate()
Dim lngIndex As Long
If mobjProgressBar Is Nothing Then
    Set mobjProgressBar = Controls.Add(bstrProgID:="MSComctlLib.ProgCtrl.2", _
          Name:="ProgressBar1", Visible:=True)
    With mobjProgressBar
          .Left = 20
          .Top = 20
          .Width = 200
          .Height = 30
          .Max = 10
          .Min = 0
          .Value = 0
    End With
    With CommandButton1
        .Width = 100
        .Height = 20
        .Top = mobjProgressBar.Top + mobjProgressBar.Height
        .Left = mobjProgressBar.Left
        .Caption = "Cancel_Close"
        .BackColor = &H9400D3
    End With
End If
mdtmTime = Now + TimeSerial(0, 0, 10)
Call Application.OnTime(EarliestTime:=mdtmTime, Procedure:="prcTimer")
With mobjProgressBar
    For lngIndex = .Min To .Max
        If Not Visible Then Exit For
        .Value = lngIndex
        Caption = "Datei wird geschlossen in " & _
           .Max - lngIndex & " Sec"
        DoEvents
        Call Sleep(1000&)
        Call Repaint
    Next
End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = CloseMode <> vbFormCode
End Sub

Private Sub UserForm_Terminate()
Call Application.OnTime(EarliestTime:=mdtmTime, _
    Procedure:="prcTimer", Schedule:=False)
Set mobjProgressBar = Nothing
End Sub

Friend Property Get prpblnInit() As Boolean
Let prpblnInit = mblnInit
End Property

Friend Property Let prpblnInit(ByVal pvblnInit As Boolean)
Let mblnInit = pvblnInit
End Property
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Klassenmodul der Arbeitsmappe
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Static sblnTerminate As Boolean
If Not (ReadOnly Or sblnTerminate) Then
    Call Unload(Object:=UserForm1)
    sblnTerminate = True
End If
End Sub

Private Sub Workbook_Open()
If Not ReadOnly Then _
    Call Application.OnTime(EarliestTime:=Now + TimeSerial(0, 0, GC_TIME_SEC), Procedure:="prcTimer")
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Standardmodul
' **********************************************************************

Option Explicit
Option Private Module

Public Const GC_TIME_SEC As Integer = 30

Public Sub prcTimer()
With UserForm1
    If .prpblnInit Then
      Call ThisWorkbook.Save
      Call Application.Quit
    Else
      .prpblnInit = True
      Call .Show
    End If
End With
End Sub


Gruß,


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
21.09.2017 17:41:42 Alfons
NotSolved
22.09.2017 06:58:15 Gast30061
NotSolved
22.09.2017 08:04:14 Alfons
NotSolved
Blau Excel automatisch schließen
23.09.2017 06:49:00 Gast20082
NotSolved
03.10.2017 16:53:42 Alfons
NotSolved
03.10.2017 18:08:07 Ben
NotSolved
04.10.2017 16:58:31 Gast35240
NotSolved
04.10.2017 17:07:49 Alfons
NotSolved
04.10.2017 19:58:05 Gast54132
NotSolved