< návrat zpět

MS Excel


Téma: Uložit s dvěma podsložkami rss

Zaslal/a 9.11.2020 10:18

Dobrý den
V D1 mám zadanou cestu ke složce "Zaměstnanci". Makro v této složce vytvoří neexistující složku podle buňky B3 (rok) a do ní uloží soubor podle směny (B2) a jména (B1) .xlsm. Více by mi vyhovovalo, aby makro vytvořilo složku podle B3 (rok), v ní vytvořilo složku podle směny (B2) a teprve do ní uložil soubor podle B1 (jméno).xlsm.
Děkuji

Příloha: rar48825_zaklad.rar (14kB, staženo 18x)
Zaslat odpověď >

#048828
elninoslov
Použiť môžete nejakú univerzálnejšiu metódu, kde je jedno koľko vnorení budete požadovať. Napr. :
Sub Ulozit()
Dim strCesta As String, strJmeno As String, strFolder As String

With wksUvod
strFolder = .Range("D1").Value & "\" & Year(.Range("B3").Value) & "\" & .Range("B2").Value
strJmeno = .Range("B1").Value
End With

VytvorAdresar strFolder

strCesta = strFolder & "\" & strJmeno & ".xlsm"
ThisWorkbook.SaveAs Filename:=strCesta, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Sub VytvorAdresar(Cesta As String)
Dim sC() As String, dC() As String, i As Byte

If Right$(Cesta, 1) <> "\" Then Cesta = Cesta & "\"
dC = Split(Cesta, ":\")
sC = Split(dC(1), "\")

Cesta = dC(0) & ":"

For i = 0 To UBound(sC)
If sC(i) <> "" Then
Cesta = Cesta & "\" & sC(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
End If
Next i
End Sub

viď tu
Příloha: zip48828_zaklad.zip (15kB, staženo 20x)
citovat
#048834
avatar
Diky moc.citovat

Uživatelské menu

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

Menu

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.

On-line nástroje