Keresés

Új hozzászólás Aktív témák

  • Fferi50

    Topikgazda

    válasz Delila_1 #23348 üzenetére

    Szia!

    Sikerült még rövidítenem a Thisworkbook BeforeClose -on:

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If MsgBox("Valóban kilép?", vbQuestion + vbYesNo, "Bezárás") = vbNo Then
    Cancel = True
    Else
    valasz = MsgBox("Menti a változásokat?", vbQuestion + vbYesNoCancel, "Bezárás")
    If valasz = vbCancel Then Cancel = True: Exit Sub
    If Munka1.fmtcondis.Count > 0 Then
    For Each fmt In Munka1.fmtcondis
    fmt.Delete
    Munka1.fmtcondis.Remove 1
    Next
    End If
    If valasz = vbNo Then
    ThisWorkbook.Saved = True
    kilepo = True
    Else
    kilepo = True
    ThisWorkbook.Save
    End If
    End If
    End Sub

  • Fferi50

    Topikgazda

    válasz Delila_1 #23348 üzenetére

    Szia!

    Ezt kell a Thisworkbook kódlapjára beírni:
    Public kilepo As Boolean
    Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    If kilepo Then Exit Sub
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Offset(0, -1).Select
    Application.ScreenUpdating = True
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Munka1.fmtcondis.Count > 0 Then
    For Each fmt In Munka1.fmtcondis
    fmt.Delete
    Munka1.fmtcondis.Remove 1
    Next
    End If
    If MsgBox("Valóban kilép?", vbQuestion + vbYesNo, "Bezárás") = vbNo Then
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Offset(0, -1).Select
    Application.ScreenUpdating = True
    Cancel = True
    Else
    valasz = MsgBox("Menti a változásokat?", vbQuestion + vbYesNoCancel, "Bezárás")
    If valasz = vbNo Then
    ThisWorkbook.Saved = True
    kilepo = True
    ElseIf valasz = vbYes Then
    kilepo = True
    ThisWorkbook.Save
    Else
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Offset(0, -1).Select
    Application.ScreenUpdating = True
    Cancel = True
    End If
    End If
    End Sub

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Munka1.fmtcondis.Count > 0 Then
    For Each fmt In Munka1.fmtcondis
    fmt.Delete
    Munka1.fmtcondis.Remove 1
    Next
    End If
    End Sub

    Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Offset(0, -1).Select
    Application.ScreenUpdating = True
    End Sub

    Ezzel elérhető, hogy a "célkeresztet" nem menti le, de a fájl megnyitásakor első dolga, hogy létrehozza: ezért lép oda-vissza egyet az aktív munkalapon.
    Mentés előtt eltünteti a célkeresztet, de ha csak mentés volt, utána vissza is hozza.
    Kilépéskor végigjátssza a verziókat, ha mégsem lép ki, akkor marad a célkereszt.

    Üdv.

Új hozzászólás Aktív témák