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
Smazání dat s podmínkou Vyřešeno
-
- Level 2
- Příspěvky: 165
- Registrován: září 17
- Pohlaví:
Re: Smazání dat s podmínkou
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"?
Ten výmaz dat se týče listu "List1" nebo listu "Sestava"?
-
- nováček
- Příspěvky: 46
- Registrován: březen 22
- Pohlaví:
Re: Smazání dat s podmínkou
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.
-
- Level 2
- Příspěvky: 165
- Registrován: září 17
- Pohlaví:
Re: Smazání dat s podmínkou
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
-
- nováček
- Příspěvky: 46
- Registrován: březen 22
- Pohlaví:
Re: Smazání dat s podmínkou
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
Vámi upravený kód v případě že zadám, že nechci ostranit list neprovede žádnou akci
-
- Level 2
- Příspěvky: 165
- Registrován: září 17
- Pohlaví:
Re: Smazání dat s podmínkou
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?
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?
-
- nováček
- Příspěvky: 46
- Registrován: březen 22
- Pohlaví:
Re: Smazání dat s podmínkou
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
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
-
- Level 2
- Příspěvky: 165
- Registrován: září 17
- Pohlaví:
Re: Smazání dat s podmínkou
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
-
- nováček
- Příspěvky: 46
- Registrován: březen 22
- Pohlaví:
Re: Smazání dat s podmínkou Vyřešeno
Super díky
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Žádám o uzavření účtu a smazání příspěvků
od Uziv00 » 16 črc 2024 09:30 » v PC-HELP - připomínky k fóru - 1
- 3810
-
od Ltb
16 črc 2024 10:10
-
Kdo je online
Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 7 hostů