napadlo ma spraviť také makro ktoré by spravilo 'uložiť ako' a uložilo subor ale keby nazvy ktore maju zmes pismen a čisel mali postupnosť nieje problem, lenže nazvy su nahodne formát 'nejaký_string'-'nahodne_cislo' a to je pre mna problem...citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Vytvorenie suborov a pomenovanie
MS Excel
Téma: Vytvorenie suborov a pomenovanie 
Zaslal/a 8.8.2013 10:46
Zdravím, mam nasledujúci problém. Mám vypracovaný excel .xls (verzia 2003), ktorý potrebujem nakopírovať (naklonovať) a dané kópie(klony) premenovat podla dodaného zoznamu a rozdriedit do rôznych zložiek. Príklad: subory by sa volali 00000-99999 a boly by v zložkách po tisícoch, čiže 00000-00999 by bolo v zložke 0, 01000-01999 by bolo v zložke 1, atď. Ďakujem za rady 
(8.8.2013 10:57)#014626
100000 kopií jednoho souboru?
mno když chcete, tak by to bylo nějak takto (sorry, ale 100000 souborů vytvářet nebudu, takže to zkuste otestovat u sebe ;)))) )
Sub subCopy()
Dim sExt As String
sExt = ThisWorkbook.FullName
sExt = Mid(sExt, InStrRev(sExt, "."))
Dim sDir As String
Dim I As Long
For I = 0 To 99999
sDir = ThisWorkbook.Path & Application.PathSeparator & Format(I \ 1000, "00") & "000"
If Dir(sDir) = vbNullString Then
MkDir sDir
End If
' FileCopy ThisWorkbook.FullName, sDir & Application.PathSeparator & Format(I, "00000") & sExt
ThisWorkbook.SaveCopyAs sDir & Application.PathSeparator & Format(I, "00000") & sExt
Next I
End Sub
FileCopy by bylo lepší, ale funguje jen v případě zavřeného kopírovaného souborucitovat
mno když chcete, tak by to bylo nějak takto (sorry, ale 100000 souborů vytvářet nebudu, takže to zkuste otestovat u sebe ;)))) )
Sub subCopy()
Dim sExt As String
sExt = ThisWorkbook.FullName
sExt = Mid(sExt, InStrRev(sExt, "."))
Dim sDir As String
Dim I As Long
For I = 0 To 99999
sDir = ThisWorkbook.Path & Application.PathSeparator & Format(I \ 1000, "00") & "000"
If Dir(sDir) = vbNullString Then
MkDir sDir
End If
' FileCopy ThisWorkbook.FullName, sDir & Application.PathSeparator & Format(I, "00000") & sExt
ThisWorkbook.SaveCopyAs sDir & Application.PathSeparator & Format(I, "00000") & sExt
Next I
End Sub
FileCopy by bylo lepší, ale funguje jen v případě zavřeného kopírovaného souborucitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články