Příspěvky uživatele


< návrat zpět

Strana:  1 2 3 4 5 6 7 8 9   další » ... 13
zalohovanie excel zosita (5.3.2025 5:52)

Ahoj,
do původního kódu (nahoře) jsem přidal cestu, kterou jsi napsal 1

zalohovanie excel zosita (4.3.2025 19:11)

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ěší 1

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 Sub

Docházkový formulář (4.3.2025 12:03)

ahoj,
já na to použil makro 2

zde jsou věci které jsem přidal:
1. Při kliknutí na buňku v rozsahu "A9:A39" se zobrazí rozevírací seznam s volbami: "x", "d", "n", "s".

2. Kliknutím na buňku "A1" se automaticky vyplní docházka pro celý měsíc: "x" pro pracovní dny, "s" pro svátky (kromě víkendů) a prázdné buňky pro víkendy.

3. Kliknutím na buňku "A2" se smažou všechny zadané hodnoty v rozsahu "A9:A39", což usnadňuje rychlé vymazání docházky.

4. Při zadání "d" (dovolená) nebo "n" (nemoc) se zobrazí InputBox, kde zadáte počet dnů pro zvolený stav.

5.Pokud zadáte příliš vysoký počet dnů (např. více dnů dovolené, než zbývá do konce měsíce), makro vás upozorní a automaticky omezí rozsah na maximální možný počet dnů.

6. dovolil jsem si výběr měsíců upravit, v buňce H3 je rozevírací seznam s měsíci , při změně vyčistí docházku, přepíše datumy a upraví řádky (schová řádky, dle počtu dnů v měsíci)

kopírování textu (25.2.2025 7:18)

Ahoj,
tato jsi to myslel? viz příloha

kopírování textu (23.2.2025 19:22)

ahoj,
nechápu moc zadání, bylo by lepši víc rozepsat

Formulář (23.2.2025 19:11)

ahoj,

viz příloha

MsgBox kontrola souborů (18.2.2025 9:42)

opravené makro,
samozřejmě pokud by těch souborů bylo víc, chtělo by ten kód přepsat (zjednodušit)
Sub AktualizaceDat()

Dim Cesta As String
Dim Soubor1 As String, Soubor2 As String, Soubor3 As String
Dim ChybejiciSoubory As String
Dim I As Integer

Cesta = ThisWorkbook.Path & "\"
Soubor1 = "01.xlsx"
Soubor2 = "02.xlsx"
Soubor3 = "03.xlsx"

' Inicializace prázdného řetězce pro chybějící soubory
ChybejiciSoubory = ""

' Kontrola existence souborů a přidání chybějících do seznamu
If Len(Dir(Cesta & Soubor1, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor1
If Len(Dir(Cesta & Soubor2, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor2
If Len(Dir(Cesta & Soubor3, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor3

' Pokud nějaký soubor chybí, zobrazíme pouze ty chybějící
If ChybejiciSoubory <> "" Then
MsgBox "Následující soubory neexistují:" & vbCrLf & ChybejiciSoubory, vbCritical, "Kontrola souborů"
Exit Sub
End If

' Pokud všechny soubory existují, zobrazíme datum poslední aktualizace a dotaz na aktualizaci
I = MsgBox(Soubor1 & " - " & FileDateTime(Cesta & Soubor1) & vbCrLf & _
Soubor2 & " - " & FileDateTime(Cesta & Soubor2) & vbCrLf & _
Soubor3 & " - " & FileDateTime(Cesta & Soubor3) & vbCrLf & vbCrLf & _
"Zahájit aktualizaci?", vbYesNo, "Vygenerováno.")

Select Case I
Case vbNo
Exit Sub
Case vbYes
MsgBox "Call Aktualizace"
'Call Aktualizace
End Select
End Sub

Smazání VBA kódu ke konkrétnímu datu? (16.2.2025 7:30)

Já to včera zkoušel přes registr,
ale změna se stejně projevila až po nahlédnutí do "Nastavení centra zabezpečení".
Nepomohlo ani restart Excelu a ani PC, alespoň ne na Office 365.
WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Excel\Security\AccessVBOM", 1, "REG_DWORD"

Smazání VBA kódu ke konkrétnímu datu? (14.2.2025 7:33)

Stačí přinutit uživatele aby si povolil objektové moduly už při prvním použití sešitu. Třeba zamknutím celého sešitu, nebo schovaní listů atd...

Smazání VBA kódu ke konkrétnímu datu? (13.2.2025 12:39)

Ahoj, tady makro viz níže, které maže komplet všechny makra co je v sešite.
Vložit do Thisworkbook

Private Sub Workbook_Open()
Dim VBProj As Object
Dim VBComp As Object
Dim Modul As Object
Dim DatumSmazani As Date

' Nastav požadované datum smazání
DatumSmazani = DateValue("2025-02-13") ' Změň na požadované datum

' Pokud je dnešní datum vyšší nebo rovno zadanému datu, smaže kód
If Date >= DatumSmazani Then
' Povolit přístup k VBA projektu
Set VBProj = Thisworkbook.VBProject

' Projít všechny moduly a smazat je
For Each VBComp In VBProj.VBComponents
Select Case VBComp.Type
Case 1, 2, 3 ' Standardní moduly, třídy a uživatelské formuláře
VBProj.VBComponents.Remove VBComp
Case 100 ' Modul sešitových událostí (např. ThisWorkbook, List1,...)
Set Modul = VBComp.CodeModule
Modul.DeleteLines 1, Modul.CountOfLines
End Select
Next VBComp
MsgBox "Uplinula doba trial verze, všekeré makra byly odstraněny!"
End If
End Sub

Smazání VBA kódu ke konkrétnímu datu? (13.2.2025 8:38)

A co ten datum?
Bude vázaný na buňku, fixně nastavený v makru, z userformu, nebo jakým způsobem se dopracuje k tomu datumu?

Harmonogram - vypsat data počátku a konce (13.2.2025 7:22)

Písmo ve sloupcích "E:G" (jak píše elnino) byla bíla barva.
A já se divil proč mi vzorec nic nevrací 5
Koukám, že já zadaní špatně pochopil ohledně vzorců "F:G", elninoslov to má správně. Tak to prosím ignorujte.

A sloupec "E" se bude muset dořešit, jak píše kolega, pokud práce budou na etapy a bude mezera v pracovních dnech.

A omlouvám se, že do této konverzace skáču, už se dále nebudu vměšovat 10

Harmonogram - vypsat data počátku a konce (12.2.2025 8:31)

Ahoj,
tak koukám, že mě elninoslov předběhl 5 , ale už to sem přidám když jsem se stím hrál 2

jj ta bílá barva mi taky zamotala hlavu 9 5

Vyprázdnit řádky ve více listech a seřadit. (3.2.2025 8:24)

Ahoj,
provedl jsem úpravy, přidal jsem podmínku aby bral v potaz řádky jenom 2 až 150 zbytek přeskočí.
Taky jsem upravil duplicitu. není to zrovna elegantní řešení, ale snad funkční. Pokud by to někdo chtěl upravit nebudu se zlobit 3

Vyprázdnit řádky ve více listech a seřadit. (30.1.2025 12:27)

ahoj,
tak snad jsem pochopil zadaní, původní makro jsem zakomentoval a dal tam svůj, plus jsem přidal seřazení dat pro ostatní listy. Dělá to jenom do řádku 150 jak bylo i v zadání.
Radši si to pořádně zkontroluj jestli to dělá co má, než použiješ naostro.


Strana:  1 2 3 4 5 6 7 8 9   další » ... 13

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