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
Chyba v makru
Moderátor: Mods_senior
-
pavel.lasak
- Level 2

- Příspěvky: 197
- Registrován: 28 dub 2012 08:05
- Kontaktovat uživatele:
Re: Chyba v makru
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
Více o kancelářském balíku MS Office na http://office.lasakovi.com/ (Word, Excel, PowerPoint, Access, Outlook, Project, OneNote)
Re: Chyba v makru
Díky za za pomoc. Už to chodí jak má.
-
- Podobná témata
- Odpovědi
- Zobrazení
- Poslední příspěvek

