< návrat zpět

MS Excel


Téma: otevření *.xls a jeho uložení jako 1 2 3.xls rss

Zaslal/a 20.10.2014 13:13

Ahoj,
ve složce mám soubory:
krycí list.xls a
1.xls
2.xls
.
.
86.xls
a potřeboval bych zda by někdo nedal dohromady macro které by dokázalo otevřít soubor krycí list.sxl a uložit ho jako další číslo.xls

tzn. když bude ve složce 1-86.xls tak aby se uložil jako 87.xls.

Zaslat odpověď >

Strana:  « předchozí  1 2
#022054
avatar
Nešlo by tam přidat:
Když kolega z "jen pro čtení" vytvoří soubor a já pak dám přidat nový záznam aby ho nepřepisoval ale spíše přidal do mnou otevřené přehledové tabulky? Tím by se vše vyřešilo i to i když budeme přidávat zároveň s kolegou nové soubory kdyby se dotáhly již nalinkované soubory do tabulky. Teda pokud to jde :)citovat
#022074
avatar
Já jsem právě v souboru pro čtení přidání záznamu zakázal. S prací nad jedním souborem nemám zkušenosti, moc si to nedovedu představit, nemám to ani kde vyzkoušet. Obávám se, že už víc nepomůžu. 7citovat
#022076
avatar
V tom případě by mi stačilo kdyby jsi mi do toho minulého přidal při vytvoření souboru link na něj do buňky A:A.
Soubory se budou vytvářet podle kontroly součtu souborů v adresáři a odkazy budu mít jako doteď předpřipravený a budu šťastný :)citovat
#022124
avatar
Tak mě nic jiného nenapadlo bohužel to musí být řešeno přes odkazy když nás má v tabulce pracovat více než jeden :( Takže když to půjde jen prosím přidej hypertextový odkaz v přehledové tabulce na vytvořený soubor.

Sub ulozit_jako_dalsi()

Dim soubor_zdroj As Workbook
Dim soubor As String
Dim soubor_novy As String
Dim akt_cesta As String
Dim i As Double

akt_cesta = "\\apache\Spol\Krycí listy"
' zjistit posledni cislo souboru
soubor = Dir(akt_cesta & "\*.xls")
i = 0
Do While soubor <> "" ' opakuje dokud existuje soubor
If soubor <> "krycí list.xls" _
And Right(soubor, 4) = ".xls" Then
i = i + 1
End If
soubor = Dir 'nacteni dalsiho souboru
Loop

' kontrola zda "krycí list.slx" neni otevreny
Set soubor_zdroj = Nothing
On Error Resume Next
Set soubor_zdroj = Workbooks("krycí list.xls")
On Error GoTo 0
If Not soubor_zdroj Is Nothing Then ' then plati, kdyz je otevren
GoTo Pokracovat
Else ' else plati, kdyz neni otevren
Set soubor_zdroj = Nothing
Set soubor_zdroj = Workbooks.Open _
(akt_cesta & "\krycí list.xls")
End If
Pokracovat:

soubor_novy = i + 1 & ".xls"
soubor_zdroj.SaveAs Filename:=akt_cesta & "\" & soubor_novy, _
FileFormat:=xlExcel8

End Sub


Zkoušel jsem script upravit "spatlat" sám ale tak jsem se do toho zamotal že jsem svůj pokus musel smazat :Dcitovat
#022134
avatar
Tak i když to určitě není zapsáno ideálně tak to ale funguje :)

Sub novy_zaznam111()
Dim posl_radek As Double
Dim soubor_zdroj As Workbook
Dim soubor As String
Dim soubor_novy As String
Dim soubor_novy2 As Double
Dim akt_cesta As String
Dim i As Double

Dim GetActiveWB As String


akt_cesta = "C:\Users\mara\Documents\Excel\Tabulka samovyplňovací\test\krycí listy"
' zjistit posledni cislo souboru
soubor = Dir(akt_cesta & "\*.xls")
i = 0
Do While soubor <> "" ' opakuje dokud existuje soubor
If soubor <> "krycí list.xls" _
And Right(soubor, 4) = ".xls" Then
i = i + 1
End If
soubor = Dir 'nacteni dalsiho souboru
Loop

soubor_novy2 = i + 1

GetActiveWB = ThisWorkbook.Path & "\krycí listy\" & soubor_novy2 & ".xls"

posl_radek = 8
ActiveSheet.Hyperlinks.Add Anchor:=Cells(posl_radek + i, 1), _
Address:=GetActiveWB

' kontrola zda "krycí list.slx" neni otevreny
Set soubor_zdroj = Nothing
On Error Resume Next
Set soubor_zdroj = Workbooks("krycí list.xls")
On Error GoTo 0
If Not soubor_zdroj Is Nothing Then ' then plati, kdyz je otevren
GoTo Pokracovat
Else ' else plati, kdyz neni otevren
Set soubor_zdroj = Nothing
Set soubor_zdroj = Workbooks.Open _
(akt_cesta & "\krycí list.xls")
End If
Pokracovat:

soubor_novy = i + 1 & ".xls"
soubor_zdroj.SaveAs Filename:=akt_cesta & "\" & soubor_novy, _
FileFormat:=xlExcel8
end sub
citovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Čas od do

jarek1111 • 18.4. 13:46

Čas od do

lubo • 18.4. 11:13

Čas od do

jarek1111 • 18.4. 8:32

Čas od do

jarek1111 • 18.4. 8:31

Makro smyčka

MilanKop • 18.4. 7:18

Makro smyčka

elninoslov • 18.4. 0:18

Makro smyčka

MilanKop • 17.4. 21:33