ahoj, chybí příloha
ale, podívej se na tohle třeba pomůže
Ahoj,
náhodná čísla, se ti mění proto, že funkce NÁHČÍSLO() se aktualizuje pokaždé, když Excel provede jakýkoli výpočet nebo změnu. Jdi na Formát > Možnosti > Výpočty a vyber Ruční. nebo vlož na začátek makra "addNewRow" tento příkaz:Application.Calculation = xlCalculationManual Takto bude Excel aktualizovat vzorce pouze tehdy, když stiskneš F9. pokud ti to takto nebude vyhovovat tak jediné náhodně generovat makrem, než vzorcem.
Dobrý den,
zkuste tohle vložit do modulu VBA.
pro tabulku 1: C5:M30
Sub Tisk_Tab1()
Dim pocetKopii As Integer
' Zadejte počet kópií
pocetKopii = InputBox("Zadajte počet kópií pre tabuľku 1:", "Počet kópií")
If IsNumeric(pocetKopii) And pocetKopii > 0 Then
With ActiveSheet.PageSetup
.PrintArea = "$C$5:$M$30"
End With
' Zobrazení náhledu tisku
ActiveSheet.PrintOut Preview:=True, Copies:=pocetKopii
Else
MsgBox "Prosím, zadajte platné číslo kópií.", vbExclamation
End If
End Sub
pro tabulku 2: E13:I50
Sub Tisk_Tab2()
Dim pocetKopii As Integer
' Zadejte počet kópií
pocetKopii = InputBox("Zadajte počet kópií pre tabuľku 2:", "Počet kópií")
If IsNumeric(pocetKopii) And pocetKopii > 0 Then
With ActiveSheet.PageSetup
.PrintArea = "$E$13:$I$50"
End With
' Zobrazení náhledu tisku
ActiveSheet.PrintOut Preview:=True, Copies:=pocetKopii
Else
MsgBox "Prosím, zadajte platné číslo kópií.", vbExclamation
End If
End Sub
Dobrý den,
Správné organizování kódu ve VBA je důležité nejen pro rychlost provádění, ale také pro udržitelnost, přehlednost a možnost snadného ladění a rozšiřování kódu v budoucnu. Zde jsou některé klíčové aspekty, které byste měli zvážit:
1. Ukládání Makra v Samostatných Modulech:
Výhody:
Přehlednost a organizace: Když jsou makra uložena v samostatných modulech, je snazší kód organizovat a rozdělit na logické části. Každý modul může mít specifickou funkci, což usnadňuje orientaci v kódu.
Znovupoužitelnost: Makra uložená v samostatných modulech lze snadno volat z jiných listů nebo dokonce z jiných sešitů.
Snadné ladění a údržba: Při ladění kódu je jednodušší najít a opravit chyby v dobře organizovaném kódu, než když je vše smíchané v jednom místě.
Nevýhody:
Menší srozumitelnost pro začátečníky: Pokud nejste zvyklí na práci s moduly, může být zpočátku matoucí rozdělovat kód do více částí.
2. Ukládání Makra v Modulích Listů (např. Sheet1):
Výhody:
Jednoduchost: Pokud máte jednoduchá makra a pracujete jen s jedním listem, může být uložení kódu přímo v modulu listu rychlejší a jednodušší na správu.
Přímá vazba na konkrétní list: Makra, která jsou specifická pro určitý list, mohou být výhodně umístěna přímo v jeho modulu.
Nevýhody:
Omezená znuvupoužitelnost: Makra uložená přímo v modulu listu nejsou snadno dostupná z jiných listů nebo sešitů.
Nepřehlednost při růstu projektu: S rostoucím počtem makra může být složité udržet přehled o tom, co se kde nachází, zvláště pokud jsou všechna makra ve stejném modulu.
3. Dopad na Výkon:
Výkonové rozdíly mezi moduly a listy: Z pohledu výkonu samotného není zásadní rozdíl mezi umístěním makra do samostatného modulu nebo do modulu listu. Rozdíl je spíše v přehlednosti a udržovatelnosti kódu.
Správné rozdělení kódu: Správné rozdělení kódu do modulů může zlepšit efektivitu práce, usnadnit ladění a zlepšit čitelnost kódu, což nepřímo přispívá k rychlejšímu a spolehlivějšímu vývoji aplikací v Excelu.
Ahoj,
vlož modul "Zamok" z přílohy, a starý modul "Oprava" smaž.
Omlouvám se za tak podrobný popis nevím jaké máš znalosti VBA, proto raději to rozepisuji víc.
1.Upravil jsem makro, ale původně nebylo řečeno, že je tam víc listů (hárků). Teď ale by mělo zamykat všechny listy
2. Přidal jsem kontextové menu pro volání makra ZamknutBunky nebo odemknutBunky to znamená že při kliknutím pravým tlačítkem myši, se na spodku lišty ukáže rozevírací menu s názvem "Zámok Hárkov" pro správnou funkčnost je potřeba přidat příkaz do "ThisWorbook" ve VBA editoru , uložit a restartovat Excel.Private Sub Workbook_Open()
Call PridejKontextMenu
End Sub
3. Na to, aby se ti spouštěli jiné makra pro zápis do buněk, budeš muset v každém makru zavolat na začátku příkaz "Call OdomknutZosit" a na konec zase příkaz "Call ZamknutZosit".
Příklad je uvedený v modulu (poslední makro)
4. Přidal jsem InputBox pro zadávání hesla při odemykání momentálně je heslo nastavené na 1111 ,takže při manuálním odemykání buněk budeš vyzván k zadání hesla, při ostatních volaní maker, heslo žádat nebude, stejně nebude vyskakovat msgbox o zamknuti nebo odemknuti.
ahoj,
vyzkoušej tohle (viz příloha). Udělal jsem tam pár změn.
Pokud by to stále nefungovalo musel bych vidět ten sešit.
*rozbal a naimportuj modul "oprava" do svého sešitu.
ahoj zkus tohle:
Option Explicit
Dim heslo As String
Sub NastavitHeslo()
heslo = "tvojeHeslo"
End Sub
Sub ZamknutZosit()
Call NastavitHeslo
Dim ws As Worksheet
' Zamknutie konkrétnych hárkov
Set ws = ThisWorkbook.Sheets("Hárok1")
ws.Unprotect Password:=heslo
ws.Cells.Locked = True
ws.Range("H5,H7,E13:E64,E76:G128,G13:G64,G76:G128,D132,D134,D136,D138").Locked = False
ws.Protect Password:=heslo, AllowUsingPivotTables:=True, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True
ws.EnableSelection = xlUnlockedCells
Set ws = ThisWorkbook.Sheets("Hárok2")
ws.Unprotect Password:=heslo
ws.Cells.Locked = True
ws.Range("D2").Locked = False
ws.Protect Password:=heslo, AllowUsingPivotTables:=True, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True
ws.EnableSelection = xlUnlockedCells
Set ws = ThisWorkbook.Sheets("Hárok5")
ws.Unprotect Password:=heslo
ws.Cells.Locked = True
ws.Range("E1,F1,E53:E56,H53:H56").Locked = False
ws.Protect Password:=heslo, AllowUsingPivotTables:=True, AllowSorting:=True, AllowFiltering:=True, AllowFormattingCells:=True
ws.EnableSelection = xlUnlockedCells
' Zamknutie celého zošita
ThisWorkbook.Protect Password:=heslo, Structure:=True, Windows:=False
MsgBox "Zošit a hárky boli úspešne zamknuté."
End Sub
Sub OdomknutZosit()
Call NastavitHeslo
Dim ws As Worksheet
' Odomknutie konkrétnych hárkov
Set ws = ThisWorkbook.Sheets("Hárok1")
ws.Unprotect Password:=heslo
ws.Range("H5,H7,E13:E64,E76:G128,G13:G64,G76:G128,D132,D134,D136,D138").Locked = True
Set ws = ThisWorkbook.Sheets("Hárok2")
ws.Unprotect Password:=heslo
ws.Range("D2").Locked = True
Set ws = ThisWorkbook.Sheets("Hárok5")
ws.Unprotect Password:=heslo
ws.Range("E1,F1,E53:E56,H53:H56").Locked = True
' Odomknutie celého zošita
ThisWorkbook.Unprotect Password:=heslo
MsgBox "Zošit a hárky boli úspešne odomknuté."
End Sub
Ty kráso, to jsem ale lama.
Děkuji ti Lubo, perfektní
Ahoj všem,
mám soubor kde mi graf vyhodí rovnice lineárního trendu, které potřebuji dále pak použít.
A abych je nemusel ručně vypisovat, tak jsem si myslel že zvládnu vzorečkem hodnoty vypočítat.
Použil jsem SLOPE, INTERCEPT a LINREGRESE, ale ani jedno mi nevrací úplně hodnoty, které jsou v grafu.
Já moc znalý v těchto věcech nejsem, tak pokud by byl někdo ochotný mi pomoct byl bych moc vděčný.
Posílám soubor pro lepší pochopení mého problému.
Dobrý den,
přidal jsem ještě kontrolu jestli je list (hárok) číslo, nebo ne. Tohle by mel eliminovat problém.
Co se týče mazaní a chybové hlášky, tam nevím co je za problém.
Makra moc nemají rády pokud se přesouvají buňky.
Přidal jsem ale pro kontrolu msgbox kde Vás vybídne pro kontrolu pár věcí.
Pokud ani teď by se nevyřešil problém, bude se muset celý koncept přepsat, ale to už bych tady neřešil.
Spíš bych Vám poslal do vzkazu tel. číslo a řešily bychom to třeba přes WhatsApp.
Dobrý den,
velice se omlouvám, já jsem poslal Váš původní sešit místo upraveného.
Tak snad teď.
Nekontroloval jsem Váš sešit co jste mi poslala včera, předpokládám, že jsme zadaní pochopil správně.
rádo se stalo.
Dobrý den, upraveno.
Dobrý den.
přidáno nové makro v příloze
Dobrý den,
upravil jsem kód pro druhý sešit s číselným označením listů.
Pro automatické spouštění makra po otevření sešitu vložte do "ThisWorkbook" ještě tento příkaz
Private Sub Workbook_Open()
Call KopirujDataPredoslehoMesiacaDoPoslednehoHarku
End Sub
zde je ten upravený kód:
Sub KopirujDataPredoslehoMesiacaDoPoslednehoHarku()
Dim aktMesiac As Integer
Dim predMesiac As String
Dim nazvyMesiacov As Variant
Dim aktRok As Long, predRok As Long
Dim cesta As String, nzvPredZositu As String
Dim aktZosit As Workbook, predZosit As Workbook
Dim aktHarok As Worksheet, predHarok As Worksheet
nazvyMesiacov = Array("január", "február", "marec", "apríl", "máj", "jún", "júl", "august", "september", "október", "november", "december")
'reset mesiaca
aktMesiac = -1
' Získaj aktuálny Zošit a Hárok
Set aktZosit = ThisWorkbook
Set aktHarok = aktZosit.Sheets("Hárok2")
If aktHarok.Range("D2").Value = "" Then
MsgBox "Bunka D2:E2 je prázdná, doplnte mesiac do danej bunky"
Exit Sub
End If
' Získaj aktuálny mesiac a rok z názvu súboru
On Error Resume Next
aktMesiac = Application.Match(LCase(aktHarok.Range("D2").Value), nazvyMesiacov, 0)
If aktMesiac = -1 Then
MsgBox "Hľadaný mesiac v bunke D2:E2 """ & aktHarok.Range("D2").Value & """, je nesprávne napísaný. upravte text mesiaca."
Exit Sub
End If
aktRok = Replace(aktHarok.Range("F2").Value, "/", "")
On Error GoTo 0
If aktHarok.Range("F2").Value = "" Or aktRok = 0 Then
MsgBox "Hľadaný rok v bunke F2 """ & aktHarok.Range("F2").Value & """, je buď prázdná, alebo neobsahuje číslo roku. upravte text roku."
Exit Sub
End If
' Nastav predchádzajúci mesiac a rok
If aktMesiac = 1 Then
predMesiac = nazvyMesiacov(11)
predRok = aktRok - 1
Else
predMesiac = nazvyMesiacov(aktMesiac - 2)
predRok = aktRok
End If
nzvPredZositu = "Súhrn " & predMesiac & " " & predRok
' Nastav predpokladané prípony súborov
Dim nalezSuboru As Boolean
Dim pripona As Variant, pripony As Variant
pripony = Array(".xlsx", ".xls", ".xlsm")
nalezSuboru = False
' Skontroluj každú príponu súboru
For Each pripona In pripony
cesta = aktZosit.Path & "\" & nzvPredZositu & pripona
If Dir(cesta) <> "" Then
nalezSuboru = True
Exit For
End If
Next pripona
If Not nalezSuboru Then
MsgBox "Predchádzajúci súbor neexistuje alebo cesta nie je správna: " & aktZosit.Path & "\" & nzvPredZositu
Exit Sub
End If
' Vypnutie preblikávania obrazovky
Application.ScreenUpdating = False
' Otvor predchádzajúci Zošit
Set predZosit = Workbooks.Open(cesta)
Dim harok As Worksheet
Dim menoPosHarku As String
Dim posCisloHarku As Integer
' Nájdite posledný číselný hárok
For Each harok In predZosit.Sheets
If IsNumeric(harok.Name) Then
If CLng(harok.Name) > posCisloHarku Then
posCisloHarku = CLng(harok.Name)
menoPosHarku = harok.Name
End If
End If
Next harok
' Skontroluj, či bol nájdený číselný hárok
If menoPosHarku = "" Then
MsgBox "V predchádzajúcom zošite nebol nájdený číselný hárok."
predZosit.Close SaveChanges:=False
Exit Sub
End If
' Nastav predchádzajúci zošit
Set predHarok = predZosit.Sheets(menoPosHarku)
' Skopíruj údaje z predchádzajúceho zošitu do aktuálneho
aktHarok.Range("C13:N13").Value = Application.Transpose(predHarok.Range("C10:C21").Value)
' Zatvor predchádzajúci zošit bez uloženia zmien
predZosit.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "Údaje boli úspešne skopírované z " & nzvPredZositu
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.