ahoj,
zkus tohle vložit do "ThisWorkbook", ale nezapomeň si upravit cestu ke složce (priečinku)
A hlavně dej vědět, jestli je to ono, minule jsi vůbec nereagoval. Slovíčko "Děkuji" vždy potěší
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim SlozkaMegaCloud As String
Dim nazevSouboru As String
Dim cestasNovymNazvem As String
Dim i As Integer
Dim soubor As String
Dim cisloPosledniZalohy As Integer
' Nastavení cesty k záložnímu adresáři na MEGA cloudu
SlozkaMegaCloud = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & "\MEGA\Vyučtovanie\"
' Původní název souboru bez přípony
nazevSouboru = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(".xlsm"))
' Inicializace maximálního indexu
cisloPosledniZalohy = 0
' Procházení všech souborů v záložní složce
soubor = Dir(SlozkaMegaCloud & "*.xlsm")
Do While soubor <> ""
' Kontrola, zda název souboru odpovídá formátu "Záloha X - NázevSouboru.xlsm"
If InStr(soubor, "Záloha ") > 0 And InStr(soubor, " - " & nazevSouboru & ".xlsm") > 0 Then
' Získání čísla zálohy z názvu souboru
i = Mid(soubor, 8, InStr(soubor, " - " & nazevSouboru & ".xlsm") - 8)
If IsNumeric(i) Then
' Aktualizace maximálního indexu
If CInt(i) > cisloPosledniZalohy Then cisloPosledniZalohy = CInt(i)
End If
End If
soubor = Dir
Loop
' Nastavení nového indexu pro záložní soubor
i = cisloPosledniZalohy + 1
' Vytvoření názvu pro záložní soubor
cestasNovymNazvem = SlozkaMegaCloud & "Záloha " & i & " - " & nazevSouboru & ".xlsm"
' Uložení záložního souboru
ThisWorkbook.SaveCopyAs cestasNovymNazvem
End Subcitovat
zkus tohle vložit do "ThisWorkbook", ale nezapomeň si upravit cestu ke složce (priečinku)
A hlavně dej vědět, jestli je to ono, minule jsi vůbec nereagoval. Slovíčko "Děkuji" vždy potěší
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim SlozkaMegaCloud As String
Dim nazevSouboru As String
Dim cestasNovymNazvem As String
Dim i As Integer
Dim soubor As String
Dim cisloPosledniZalohy As Integer
' Nastavení cesty k záložnímu adresáři na MEGA cloudu
SlozkaMegaCloud = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & "\MEGA\Vyučtovanie\"
' Původní název souboru bez přípony
nazevSouboru = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(".xlsm"))
' Inicializace maximálního indexu
cisloPosledniZalohy = 0
' Procházení všech souborů v záložní složce
soubor = Dir(SlozkaMegaCloud & "*.xlsm")
Do While soubor <> ""
' Kontrola, zda název souboru odpovídá formátu "Záloha X - NázevSouboru.xlsm"
If InStr(soubor, "Záloha ") > 0 And InStr(soubor, " - " & nazevSouboru & ".xlsm") > 0 Then
' Získání čísla zálohy z názvu souboru
i = Mid(soubor, 8, InStr(soubor, " - " & nazevSouboru & ".xlsm") - 8)
If IsNumeric(i) Then
' Aktualizace maximálního indexu
If CInt(i) > cisloPosledniZalohy Then cisloPosledniZalohy = CInt(i)
End If
End If
soubor = Dir
Loop
' Nastavení nového indexu pro záložní soubor
i = cisloPosledniZalohy + 1
' Vytvoření názvu pro záložní soubor
cestasNovymNazvem = SlozkaMegaCloud & "Záloha " & i & " - " & nazevSouboru & ".xlsm"
' Uložení záložního souboru
ThisWorkbook.SaveCopyAs cestasNovymNazvem
End Subcitovat
RSS nejnovější články