tussentijds opslaan

Status
Niet open voor verdere reacties.
W

Willem Blaas

Gebruiker
Lid geworden
30 aug 2006
Berichten
253
geacht forum,

ik werk met 2007

ik heb binnen een bestand waarbij ik gebruik maak van VBA bij de excel-objecten in "ThisWerkbook " al een paar opdrachten staan welke eea doen wanneer het bestand geopend wordt, werkt prima.

nu is de vraag : kan ik hier ook iets zetten dat het bestand iedere 5 miin opgeslagen wordt ?

of kan dit alleen met tussentijds opslaan ?


bijlage van wat er nu is staat.
Code: 
========================================================
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets("OPEN").Select
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.Zoom = 100
Application.DisplayFullScreen = False
ActiveWorkbook.Save

End Sub
=========================================================


bij voorbaat dank.
 
Laatst bewerkt door een moderator:
Misschien ben je hier wel iets mee...
In de Thisworkbook module:
Code: 
Private Sub Workbook_Activate()
    Sheets(1).Cells(1, 1).Value = Time
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Het werkt als volgt:
Bij het openen van het werkblad wordt de huidige tijd in cel A1 geplaatst.
Als een tabblad wijzigt, wordt de (dan) huidige tijd in cel A2 gezet.
C3 maakt gewoon een verschil tussen de twee voorgaande.
C4 neemt de gehele minuten van C3 en C5 de seconden.
Als de cel C4 groter is dan 4 (vanaf vijf minuten dus) sla je op, je plaatst alweer de huidige tijd in cel A1 en de teller begint weer opnieuw.

Je kan die code natuurlijk ook gaan uitvoeren bij andere events. Dan ziet het er zo uit.
Code: 
Private Sub Workbook_Activate()
    Sheets(1).Cells(1, 1).Value = Time
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
De Applcation.EnableEvents moeten even uitgeschakeld worden om te vermijden dat de events elkaar zouden gaan triggeren (eindeloze lus).
Nu nog enkel de onnodige dingen eruit halen en de cellen (A1 tot A5) een beetje camoufleren...

Succes ermee.

Beste groeten,
Paul.
 
VB is iets anders dan VBA, verplaatst naar juiste sectie.
 
Je kan dit ook bekomen door gebruik te maken van Application.OnTime
 
paulva zei:
Misschien ben je hier wel iets mee...
In de Thisworkbook module:
Code: 
Private Sub Workbook_Activate()
    Sheets(1).Cells(1, 1).Value = Time
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Het werkt als volgt:
Bij het openen van het werkblad wordt de huidige tijd in cel A1 geplaatst.
Als een tabblad wijzigt, wordt de (dan) huidige tijd in cel A2 gezet.
C3 maakt gewoon een verschil tussen de twee voorgaande.
C4 neemt de gehele minuten van C3 en C5 de seconden.
Als de cel C4 groter is dan 4 (vanaf vijf minuten dus) sla je op, je plaatst alweer de huidige tijd in cel A1 en de teller begint weer opnieuw.

Je kan die code natuurlijk ook gaan uitvoeren bij andere events. Dan ziet het er zo uit.
Code: 
Private Sub Workbook_Activate()
    Sheets(1).Cells(1, 1).Value = Time
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    Sheets(1).Cells(2, 1) = Time
    Sheets(1).Cells(3, 1) = Sheets(1).Cells(2, 1) - Sheets(1).Cells(1, 1)
    Sheets(1).Cells(4, 1) = Minute(Sheets(1).Cells(3, 1))
    Sheets(1).Cells(5, 1) = Second(Sheets(1).Cells(3, 1))
    If Sheets(1).Cells(4, 1).Value > 4 Then
        ActiveWorkbook.Save
        Sheets(1).Cells(1, 1) = Time
    End If
    Application.EnableEvents = True
End Sub
De Applcation.EnableEvents moeten even uitgeschakeld worden om te vermijden dat de events elkaar zouden gaan triggeren (eindeloze lus).
Nu nog enkel de onnodige dingen eruit halen en de cellen (A1 tot A5) een beetje camoufleren...

Succes ermee.

Beste groeten,
Paul.
Klik om te vergroten...

bedankt, ga ik proberen
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan