Stránka 1 z 1
Smazání dat s podmínkou
Napsal: 24 dub 2022 15:19
od 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
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 15:46
od 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"?
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 15:50
od 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.
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 16:12
od 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
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 16:45
od 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
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 17:15
od 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?
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 17:43
od 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
Re: Smazání dat s podmínkou
Napsal: 24 dub 2022 17:50
od 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
Re: Smazání dat s podmínkou Vyřešeno
Napsal: 24 dub 2022 17:58
od junis
Super díky