MS Excel

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

Yerome1(29.10.2014 15:06)#022054

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

Dingo(31.10.2014 7:34)#022074

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.

citovat

Yerome1(31.10.2014 9:49)#022076

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

Yerome1(3.11.2014 12:49)#022124

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

Yerome1(4.11.2014 11:34)#022134

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

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje