• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Pomoc s chybou v kódu

Zaslal/a marficek119 10.5.2012 21:55

Snažil jsem se dát dohromady níže uvedený kód, ale je tam nějaká chyba. Můžete se mě na to prosím někdo juknout kde je chyba/chyby?
Kód by měl Vytvořit kopie stránek do samostatného sešitu, a ten pojmenovat dle Buňky a zobrazit možnost uložit jako. Před uložením ještě podmínka zkontroluje zda již sešit s tímto číslem existuje.
Už jsem bezradný. Prosím o pomoc.

Sub Export_listu()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

zdroj = ActiveWorkbook.Name
ChDir Application.ThisWorkbook.Path

novy_subor = Worksheets("Nabídka").Cells(13, 18).Value '
Listy = Array("Faktura", "Nabídka")

Workbooks.Add
ActiveWorkbook.SaveAs filename:= _
novy_subor, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

For llist = 0 To UBound(Listy)
Windows(zdroj).Activate
Sheets(Listy(llist)).Select

Sheets(Listy(llist)).Copy before:=Workbooks(novy_subor).Sheets(1)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Worksheets("List1").Delete
Worksheets("List2").Delete
Worksheets("List3").Delete
Worksheets("Nabídka").Activate
Range("A1").Select

' následuje přejmenování

nove_jmeno = "" & novy_subor ' buňka I1 - číslo faktury
' nastavení cesty pro uložení
Dim filename As Variant
filename = Application.GetSaveAsFilename(nove_jmeno, "Excel (*.xls),*.*,Excel 07 (*.xls),*.*,", 1, "Uložit jako")
If filename = False Then Exit Sub
cele_jmeno = filename

'=existuje uz soubor faktury?
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(cele_jmeno) Then
sZprava = MsgBox("Ve vámi zvoleném adresáři již tento soubor existuje, chcete tento soubor přepsat?" & vbCrLf & "...zápis v databazi bude nezměněn...", vbYesNo, "Přepsat soubor?")
Select Case sZprava
Case vbNo
Workbooks(Workbooks.Count).Close (False)
Application.CutCopyMode = False
Exit Sub
Case vbYes
End Select
End If
Next llist

Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close

End Sub

Uzamčeno - nelze přidávat nové příspěvky.

---

marjankaj(10.5.2012 22:00)#008459

Radšej prilož tvoj zošit. Takto sa to ťažko hľadá.citovat

marficek119(10.5.2012 22:10)#008460

Zde je testovací sešit. Kód je pod tlačítkem "vytvoř kopii".

Příloha: 8460_export-faktura.rar (25kB, staženo 26x)

citovat

marjankaj(11.5.2012 2:42)#008462

Neviem presne čo chceš. Možno takto

Příloha: 8462_export-faktura.zip (24kB, staženo 26x)

citovat

marficek119(11.5.2012 6:44)#008463

Díky, ještě maličkost. Podmínka, která má zjistit zda v daném adresáři již tento soubor existuje se spouští až po té, co je vytvořena kopie sešitu, takže hlásí, že už soubor s tímto jménem existuje (hlásí právě nově vytvořenou kopii). Šlo by to nějak udělat aby se nejprve zjistilo, zda soubor v adresáři existuje a pak aby se vytvořila kopie? Nevím zda jsem to vysvětlit správně.citovat

Poki(11.5.2012 11:06)#008465

Jestli potřebujete zjistit, jestli existuje nejaky soubor s presne zadanou cestou (tedy cesta k adresari a presny nazev souboru, napr. "C:\TEST\test.xlsx"), lze pouzit tuto funkci, kde parametrem bude prave cela cesta k souboru
Public Function ExistSoubor(FullName As String)
Set FSO = CreateObject("Scripting.FileSystemObject")
ExistSoubor = FSO.fileexists(FullName)
End Function
- funkce vraci bud 'True' nebo 'False'
...nebo lze pouzit objekt FileSystemObject sam o sobe v kodu...citovat

Jeza.m(11.5.2012 11:18)#008467

Osobně pro ověření existence používám DIR:
If Dir("C:\TEST\test.xlsx") <> "" Then MsgBox "EXISTUJE" Else MsgBox "NEEXISTUJE"


M@citovat

marficek.119(11.5.2012 12:34)#008469

Diky. Nazev souboru se bude menit podle cisla faktury nebo nabidky.Zkousel jsem vlozit do kodu ale nejak me to nefunguje.Uz jsem z toho jelen. Poki kam umistit tvuj kod? Muzu te poprosit o vlozeni do meho sesitu?citovat

Poki(11.5.2012 12:45)#008470

Nechce se mi studovat tvuj kod, ale funkci, kterou jsem vlozil vyse (celou), vlozis jako novou proceduru do nejakeho modulu v tvem sesitu a pak ji muzes pouzivat:

v tvem kodu bude neco takoveho:
Cesta = "C:\.....\" 'samozrejme to nebude stanoveno natvrdo - to zvladnes sam
Nazev = "nazev.xls" 'samozrejme to nebude stanoveno natvrdo - to zvladnes sam

If ExistSoubor(Cesta & Nazev) = True then
MsgBox "Soubor uz existuje"
Else
MsgBox "Soubor jeste neexistuje"
End Ifcitovat

marficek119(13.5.2012 12:00)#008474

Díky za pomoc. FUnguje přesně:-)citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse