Smazání dat s podmínkou

[junis]

Zdravím, potřeboval bych upravit kód, který maže sestavu tak, aby vyskočil MsgBox s hlášením pokud najde ještě nesmazaný list1, aby se zeptal, zda ho má taky odstranit, nebo smazat jen data.



ub Smazat_data()
'
' Smazat data
'
i = MsgBox("POZOR!! Chcete opravdu vymazat všechna data?", vbYesNo)
If i = vbYes Then Range("Sestava!a2:xfd1048576").ClearContents

End Sub

[Grimm]

pokud najde ještě nesmazaný list1, aby se zeptal, zda ho má taky odstranit, nebo smazat jen data.

Ten výmaz dat se týče listu "List1" nebo listu "Sestava"?

[junis]

Ano, pokud při mazání dat sestavy,( která je na listu2) zjistí, že ještě existuje neodstarněný list1, zeptá se, zda ho taky chceme odstarnit.

[Grimm]

Kód: Vybrat vše

Option Explicit

Sub Smazat_data()

Dim i As VbMsgBoxResult
' Smazat data
'
If ListExistuje("List1") = False Then
    i = MsgBox("POZOR!! Chcete opravdu vymazat všechna data?", vbYesNo + vbQuestion, "Výmaz dat")
    If i = vbYes Then Call Smazat
Else
    i = MsgBox("POZOR!! Chcete opravdu vymazat všechna data z Listu ""Sestava"" a odstranit list ""List1""?", vbYesNo + vbQuestion, "Výmaz dat")
    If i = vbYes Then
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
             ThisWorkbook.Worksheets("List1").Delete
             Call Smazat
            .ScreenUpdating = True
            .DisplayAlerts = True
        End With
    End If
End If
End Sub

Function ListExistuje(JmenoListu As String) As Boolean
    Dim list As Worksheet

    On Error Resume Next
        Set list = ThisWorkbook.Worksheets(JmenoListu)
    On Error GoTo 0
    
    ListExistuje = Not list Is Nothing
End Function

Private Sub Smazat()
    ThisWorkbook.Worksheets("Sestava").Range("A2:XFD1048576").ClearContents
End Sub

[junis]

Funguje to, ale chtěl jsem, aby vyskočil MsgBox s hlášením pokud najde ještě neodstraněný list1, aby se zeptal, zda ho má taky odstranit, nebo smazat jen data sestavy na listu2.
Vámi upravený kód v případě že zadám, že nechci ostranit list neprovede žádnou akci

[Grimm]

Můžeš tedy polopaticky napsat, jak si představuješ funkci makra, krok po kroku?
Kdy se mají zobrazovat a jaké hlášky?
Uvedený kód ověří existenci listu "list1" a nabídne jeho odstranění i s vymazáním dat z listu "Sestava" (nebo list2?).
Pokud "list1" neexistuje nabídne (pouze) vymazání dat z listu "Sestava".
Taky upřesni jména jednotlivých listů, nebo používáš jejich CodeName?

[junis]

Omlouvám se, asi jsem to špatně napsal. Postoupnost by měla být asi takhle.
1. kliknu smazat data
2. hláška opravdu chcete smazat veškerá data? )ANO nebo NE. Ano smaže sestavu, Ne nic neprovede.
3. pokud zjistí, že existuje ještě list1 Chcete odstranit ještě zbylý list1? ANO nebo NE

[Grimm]

Takto: ?

Kód: Vybrat vše

Option Explicit

Sub Smazat_data()

Dim i As VbMsgBoxResult
' Smazat data
'
i = MsgBox("POZOR!! Chcete opravdu vymazat všechna data?", vbYesNo + vbQuestion, "Výmaz dat")
If i = vbYes Then ThisWorkbook.Worksheets("Sestava").Range("A2:XFD1048576").ClearContents

If ListExistuje("List1") = True Then
    i = MsgBox("Chcete odstranit ještě zbylý list1?", vbYesNo + vbQuestion, "Odstranění listu")
    If i = vbYes Then
        With Application
            .DisplayAlerts = False
             ThisWorkbook.Worksheets("List1").Delete
            .DisplayAlerts = True
        End With
    End If
End If


End Sub

Function ListExistuje(JmenoListu As String) As Boolean
    Dim list As Worksheet

    On Error Resume Next
        Set list = ThisWorkbook.Worksheets(JmenoListu)
    On Error GoTo 0
    
    ListExistuje = Not list Is Nothing
End Function

[junis]

Super díky