Chyba v makru Vyřešeno

[Jsimi]

Ahoj
Prosím poradí někdo.Mám chybu v makru. Po spuštění se objeví dotaz jsou všechny udaje uvedeny správně. Po stisknutí ano proběhne vše jak má, ale když dám ne, tak makro pokračuje a já potřebuji, aby se přerušilo. Jsem lama a toto jsem vytvořil stylem pokus omyl z ruzných maker tady s fora.

Sub Zavřít()
' Kontrola před uzavřením
'
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Jsou všechny údaje uvedeny správně?" ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
' Title = "MsgBox Demonstration" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.


ActiveWorkbook.Save


MyString = "Yes" ' Perform some action.
Else ' User chose No.
MyString = "No" ' Perform some action.
End If
'Uloží změny.
ActiveWorkbook.Save
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Delete

'cesta k souboru kam se bude ukládat.
'Jde použít i thisworkbook.path pro uložení na stejné místo kde je šablona
cesta = "C:\pokus"
'jméno souboru bez koncovky
jmeno = "název souboru č." & Range("U3") 'k názvu se takhle přidá číslo pořadí dle parametru v buňce U3

'ukládá soubor s novým jménem
ThisWorkbook.SaveAs Filename:=cesta & "\" & jmeno & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Dokument uložen pod názvem " & jmeno

End Sub

[Reklama]

[pavel.lasak]

Kód: Vybrat vše



Sub Zavřít()
' Kontrola před uzavřením
'
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Jsou všechny údaje uvedeny správně?" ' Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
' Title = "MsgBox Demonstration" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
 ' context.
 ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.


 'Uloží změny.
 ActiveWorkbook.Save
ActiveSheet.Shapes.Range(Array("Button 1")).Select
 Selection.Delete

'cesta k souboru kam se bude ukládat.
'Jde použít i thisworkbook.path pro uložení na stejné místo kde je šablona
cesta = "C:\pokus"
'jméno souboru bez koncovky
jmeno = "název souboru č." & Range("U3") 'k názvu se takhle přidá číslo pořadí dle parametru v buňce U3

'ukládá soubor s novým jménem
ThisWorkbook.SaveAs Filename:=cesta & "\" & jmeno & ".xlsm", _
 FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
MsgBox "Dokument uložen pod názvem " & jmeno


 MyString = "Yes" ' Perform some action.
Else ' User chose No.
 MyString = "No" ' Perform some action.
End If


End Sub





[kuchyn]

Ahoj,
vyzkoušej za podmínku "else" vložit "exit sub"

[Jsimi]

Díky za za pomoc. Už to chodí jak má.