OpenOffice.info

deutsches Forum rund um Apache OpenOffice und LibreOffice
http://de.openoffice.info/

Datei nach Inaktivität des Benutzers/Timeout schließen

http://de.openoffice.info/viewtopic.php?t=45592

Seite 1 von 1

Datei nach Inaktivität des Benutzers/Timeout schließen

Verfasst: Mo, 27.12.2010 11:11
von Jester
(thema neu in anderem Forum gestartet: viewtopic.php?f=18&t=45601 )

Hallo, sollte mein Post wegen der vielen Makroquotes zu lang sein, bitte ich um Entschuldigung. Vllt kann mir ja jemand erklären wie man so ne Art Baumstruktur in so ein Posting rein bringt oder sowas wie ein "spoiler-versteck". EDIT: Button "Code" entdeckt! :)

TASK 1:
ich möchte per Makro eine Calc-Datei (mit n Tabellenblättern) automatisch speichern und schließen.
Das ganze soll nach Ablauf eines Timers geschehen.
Der Timeout soll 2 Minuten betragen. Die zwei Minuten sollen jedesmal neu starten wenn etwas im Dokument verändert wird.
Das Makro muss mit öffnen der Datei automatisch starten.
Makrosicherheit "mittel" bzw "niedrig" wird vorrausgesetzt.
Ein kurzer Dialog "Die Anwendung wird in 30 Sekunden beendet." mit einem "Abbrechen" oder "Sitzung verlängern" Button, welcher den Timer neustartet, wäre natürlich super.

Ich habe da was im Officeforum gefunden, vllt gibt das den ein oder anderen Denkanstoß:

Code: Alles auswählen

diesen Code unter DieseArbeitsmappe

Code:

Option Explicit

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:05"), "Hinweis" ' auf 10 Minuten ändern 00:10:00

End Sub


diese Codes alle in eine (das) UserForm
Code:

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Sub CommandButton1_Click()

UF_Hinweis.Hide

  Application.OnTime Now + TimeValue("00:00:05"), "Hinweis" ' auf 10 Minuten ändern 00:10:00
 
' Schleife wird unterbrochen
  Do
   DoEvents
    If (GetAsyncKeyState(&H1B)) <> 0 Then Exit Do
  Loop Until 1 = 2
 

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Schließkreuz wird deaktiviert
If CloseMode = 0 Then Cancel = True
 
End Sub

Private Sub Userform_Activate()
'Nach 30 Sekunden wird die Userform geschlossen
    Dim i As Integer
         
    For i = 30 To 0 Step -1
        Application.Wait Now + TimeValue("0:00:01")
        UF_Hinweis.Label2 = i
        DoEvents
    Next
 
   Unload Me
   
Call Schließen
 
End Sub


und diese Codes in ein normales Modul
Code:

Sub Schließen()
Msg = "Diese Datei wird geschlossen"
 ActiveWorkbook.Close savechanges:=True

End Sub

Sub Hinweis()
  UF_Hinweis.Show

End Sub

TASK 2:

Hat jemand Zeit und Lust mir meine Makros mal in "schön" umzuschreiben! :) Dann könnte man das eine oder andere auch dem Forum zugänglich machen.

Code: Alles auswählen

REM  *****  BASIC  *****

Sub checkin
	oDoc = thisComponent
	odoc.store
	
	dim a as double
		oCellCursor = ThisComponent.Sheets().getByName("Stempeluhr").createCursor()
		oCellCursor.GotoEndOfUsedArea(True)
		i = 0
	Do
   		a = ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i).value
   			if i > oCellCursor.getRangeAddress.EndRow then
    			msgbox "Das aktuelle Datum wurde nicht gefunden"
      			exit sub
   			end if
   		i=i+1
		Loop while a <> Fix(DateValue(date))
			oCell =  ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i-1)
			ThisComponent.GetCurrentController.select(oCell)

rem ----------------------------------------------------------------------
rem define variables
	dim document   as object
	dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
		document   = ThisComponent.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
	dim args1(1) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "By"
		args1(0).Value = 1
		args1(1).Name = "Sel"
		args1(1).Value = false

		dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())

rem ----------------------------------------------------------------------
	dim args2(1) as new com.sun.star.beans.PropertyValue
		args2(0).Name = "By"
		args2(0).Value = 1
		args2(1).Name = "Sel"
		args2(1).Value = false

		dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

   		oZell = thisComponent.getcurrentSelection()
   if not oZell.supportsService("com.sun.star.sheet.SheetCell") then
       msgbox "Bitte nur eine Zelle markieren (aktivieren)!", 48, "Fehler!"
       exit sub
   end if
   oZell.value = now()
   oZell.NumberFormat = 40
   msgbox "Ihre CheckIn-Zeit wurde registriert. Einen schönen Arbeitstag!", 48, "Info!"

End Sub

Sub pausestart
	oDoc = thisComponent
	odoc.store

	dim a as double
		oCellCursor = ThisComponent.Sheets().getByName("Stempeluhr").createCursor()
		oCellCursor.GotoEndOfUsedArea(True)
		i = 0
	Do
  		 a = ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i).value
  	 if i > oCellCursor.getRangeAddress.EndRow then
      msgbox "Das aktuelle Datum wurde nicht gefunden"
      exit sub
   end if
   i=i+1
Loop while a <> Fix(DateValue(date))
oCell =  ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i-1)
ThisComponent.GetCurrentController.select(oCell)

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1
args3(1).Name = "Sel"
args3(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())

   oZell = thisComponent.getcurrentSelection()
   if not oZell.supportsService("com.sun.star.sheet.SheetCell") then
       msgbox "Bitte nur eine Zelle markieren (aktivieren)!", 48, "Fehler!"
       exit sub
   end if
   oZell.value = now()
   oZell.NumberFormat = 40
   msgbox "Ihr Pausenstart wurde registriert. Guten Appetit! ", 48, "Info!"

End Sub

Sub pauseend
	oDoc = thisComponent
	odoc.store
dim a as double
oCellCursor = ThisComponent.Sheets().getByName("Stempeluhr").createCursor()
oCellCursor.GotoEndOfUsedArea(True)
i = 0
Do
   a = ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i).value
   if i > oCellCursor.getRangeAddress.EndRow then
      msgbox "Das aktuelle Datum wurde nicht gefunden"
      exit sub
   end if
   i=i+1
Loop while a <> Fix(DateValue(date))
oCell =  ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i-1)
ThisComponent.GetCurrentController.select(oCell)

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1
args3(1).Name = "Sel"
args3(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(1) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1
args4(1).Name = "Sel"
args4(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args4())

   oZell = thisComponent.getcurrentSelection()
   if not oZell.supportsService("com.sun.star.sheet.SheetCell") then
       msgbox "Bitte nur eine Zelle markieren (aktivieren)!", 48, "Fehler!"
       exit sub
   end if
   oZell.value = now()
   oZell.NumberFormat = 40
   msgbox "Ihr Pausenende wurde registriert. Weiterhin viel Erfolg! ", 48, "Info!"

End Sub

Sub checkout
	oDoc = thisComponent
	odoc.store
dim a as double
oCellCursor = ThisComponent.Sheets().getByName("Stempeluhr").createCursor()
oCellCursor.GotoEndOfUsedArea(True)
i = 0
Do
   a = ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i).value
   if i > oCellCursor.getRangeAddress.EndRow then
      msgbox "Das aktuelle Datum wurde nicht gefunden"
      exit sub
   end if
   i=i+1
Loop while a <> Fix(DateValue(date))
oCell =  ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i-1)
ThisComponent.GetCurrentController.select(oCell)

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1
args3(1).Name = "Sel"
args3(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(1) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1
args4(1).Name = "Sel"
args4(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(1) as new com.sun.star.beans.PropertyValue
args5(0).Name = "By"
args5(0).Value = 1
args5(1).Name = "Sel"
args5(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args5())

   oZell = thisComponent.getcurrentSelection()
   if not oZell.supportsService("com.sun.star.sheet.SheetCell") then
       msgbox "Bitte nur eine Zelle markieren (aktivieren)!", 48, "Fehler!"
       exit sub
   end if
   oZell.value = now()
   oZell.NumberFormat = 40
   msgbox "Ihr Checkout wurde registriert. Vielen Dank und einen schönen Feierabend! ", 48, "Info!"

End Sub

sub deletselected
	oDoc = thisComponent
	odoc.store
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "Flags"
	args1(0).Value = "SVDFN"

		dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args1())

	msgbox "Die Löschung wird unter Angabe Ihrer Personal ID an den Administrator gemeldet!", 48, "Zeit wurde gelöscht!"

end sub

sub resetsaveexit
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "ToPoint"
	args1(0).Value = "$A$12"

		dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

	oDoc = thisComponent
	odoc.store
	odoc.close(true)

end sub

Sub ProtectCurrentSheets()
	oDoc = thisComponent
	odoc.store
	Dim oDocument as Object
	Dim sDocType as String
	Dim iResult as Integer
	Dim oSheets as Object
	Dim i as Integer
	Dim bDoProtect as Boolean
		oDocument = StarDesktop.ActiveFrame.Controller.Model
		sDocType = GetDocumentType(oDocument)
		If sDocType = "scalc" Then
			oSheets = oDocument.Sheets
			bDoProtect = False
			For i = 0 To oSheets.Count-1
				If Not oSheets(i).IsProtected Then
					bDoProtect = True
		End If
		Next i
		If bDoProtect Then
			iResult = Msgbox( "Sollen alle Arbeitsblätter geschützt werden?",35, GetProductName())
			If iResult = 6 Then
				ProtectSheets(oDocument.Sheets)
			End If
		End If
	End If
End Sub

Sub Save

	oDoc = thisComponent
	odoc.store
	
End Sub

sub undo
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Reload", "", 0, Array())


end sub

Sub gototoday
dim a as double
oCellCursor = ThisComponent.Sheets().getByName("Stempeluhr").createCursor()
oCellCursor.GotoEndOfUsedArea(True)
i = 0
Do
   a = ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i).value
   if i > oCellCursor.getRangeAddress.EndRow then
      msgbox "Das aktuelle Datum wurde nicht gefunden"
      exit sub
   end if
   i=i+1
Loop while a <> Fix(DateValue(date))
oCell =  ThisComponent.Sheets().getByName("Stempeluhr").getCellByPosition(0,i-1)
ThisComponent.GetCurrentController.select(oCell)

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args1())

end sub

Danke und Gruß, Jester

Re: Datei nach Inaktivität des Benutzers/Timeout schließen

Verfasst: Mo, 27.12.2010 13:20
von Jester
ah, ok. Danke.
Könnte dann bitte ein Moderator mein Topic entsprechend verschieben um Doppelpostings zu vermeiden.
Danke, Jester

EDIT: habs hier mal geposted: viewtopic.php?f=18&t=45601
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de