Chyba v makru

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Zamčeno
Jsimi
Level 1.5
Level 1.5
Příspěvky: 119
Registrován: 17 čer 2012 19:12

Chyba v makru

Příspěvek od 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
pavel.lasak
Level 2
Level 2
Příspěvky: 197
Registrován: 28 dub 2012 08:05
Kontaktovat uživatele:

Re: Chyba v makru

Příspěvek od 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



Více o kancelářském balíku MS Office na http://office.lasakovi.com/ (Word, Excel, PowerPoint, Access, Outlook, Project, OneNote)
kuchyn
nováček
Příspěvky: 10
Registrován: 06 bře 2007 18:57

Re: Chyba v makru

Příspěvek od kuchyn »

Ahoj,
vyzkoušej za podmínku "else" vložit "exit sub"
Roman
Jsimi
Level 1.5
Level 1.5
Příspěvky: 119
Registrován: 17 čer 2012 19:12

Re: Chyba v makru

Příspěvek od Jsimi »

Díky za za pomoc. Už to chodí jak má.
Zamčeno
  • Podobná témata
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Chyba CPU na desce
    od petan320 » » v Problémy s hardwarem
    16 Odpovědi
    16700 Zobrazení
    Poslední příspěvek od petr22
  • Sqlite - systémová chyba
    od cindy the skull » » v Vše ostatní (sw)
    6 Odpovědi
    15912 Zobrazení
    Poslední příspěvek od atari
  • Chyba příkazový řádek
    od zik9 » » v Windows 11, 10, 8...
    4 Odpovědi
    6891 Zobrazení
    Poslední příspěvek od zik9
  • prohližeč událostí id 1796 chyba
    od walderan » » v Problémy s hardwarem
    9 Odpovědi
    10117 Zobrazení
    Poslední příspěvek od walderan
  • Windows Update nelze stáhnout, chyba 0x80070246
    od Rewqa » » v Windows 11, 10, 8...
    11 Odpovědi
    13071 Zobrazení
    Poslední příspěvek od Rewqa

Zpět na „Kancelářské balíky“