Příspěvky uživatele
< návrat zpět
No a kedy teda platí
"kabaka" napsal/a:
Súbor sa automaticky makrom uloží a pred uložením vymaže text.
Naco je v vlozitpaticku ten
ActiveWorkbook.Save
keď ho nepotrebujete ukladať?
Veď stačí tá druhá proc. Workbook_BeforeSave - tá predsa hlavičku (u Vás päta, to len ja meliem o hlavičke, sorry) vymaže.
EDIT:
Stačí iba toto, nič viac:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Worksheets("Hárok1").PageSetup.CenterFooter = "Podklady spracovala: meno,priezvisko"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets("Hárok1").PageSetup.CenterFooter = ""
End Sub
Pridanie hlavičky v BeforePrint predsa volá vlozitpaticku, a toto makro predsa ukladá ActiveWorkbook.Save, teda zavolá BeforeSave, ktorý spustí makro odstranitpaticku, a teda výsledok je, že skôr ako vytlačí, tak tú vloženú hlavičku aj odstráni.
Riešením bude asi pridanie vypínacieho príznaku.
Takže, pred tlačou sa má vložiť hlavička, a s touto vloženou hlavičkou s menom sa má súbor uložiť a vytlačiť. Po vytlačení tam hlavička s menou ostane. No pri manuálnom uložení sa má hlavička najskôr zmazať, a až potom súbor uložiť.
Hmm. No a načo sa vlastne pred tlačou ukladá súbor s menom v hlavičke, keď sa následne pri manuálnom uložení tá hlavička zmaže???
Ak dovysvetlíte logiku, tak to asi pôjde urobiť len pridaním príznaku alebo dočasným vypnutím Events ...
Logiku by to dávalo, ak by ste vytvárali kópie súboru s iným názvom alebo kopírovali uložený súbor inam ešte pred jeho zatvorením a znovuuložením a ztým pádom zmazaním hlavičky.
Sub vlozitpaticku()
Worksheets("Hárok1").PageSetup.CenterFooter = "Podklady spracovala: meno,priezvisko"
Application.EnableEvents = False
ActiveWorkbook.Save
Application.EnableEvents = True
End Sub
Ani nepamätám, kedy naposledy sa niekto niečo také opýtal. 
Ak chcete podporte toto fórum.
Ten list môžete exportovať do PDF bez vytvárania kópie.
c2 nie je premenná ale adresa bunky, takže musíte inak na bunku. Skúste to s vypnutím Calculation.
A prečo po mne kričíte?
V tom prípade neviem ako to urobiť bez straty Undo. Jednoduchý príklad tu (makro do modulu zdrojového listu):
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Target.Parent.Range("E10").Copy Destination:=ThisWorkbook.Worksheets("Hárok2").Range("D26")
End Sub
Vymeňte ten riadok ActiveWorkbook.SaveAs za
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sDir & IIf(Right(sDir, 1) <> "\", "\", "") & wList.Name & " - " & c2 & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ale aj tak ... podadresár "pdf" existuje? Application.StatusBar = False je zbytočný ak pred tým do StatusBaru nič nevpisujete. Čo s tým novovytvoreným súborom s listom? Asi zatvoriť bez uloženia (pdf už je uložené), nie ?
No a čo všetko sa má kopírovať? Hodnota, formát, písmo, formát komentu, ...
Tento príklad je možno bizarný, a vyvolá diskusie o tom, ako by funkcia (na rozdiel od procedúry) nemala meniť objekty. No ale je to jediný spôsob, ako nestratíme Undo. Lebo naproti tomu, keď budeme odchytávať vo Worksheet_Change zmenu zdrojovej bunky a meniť cieľovú, vykonáme procedúru, a tým stratíme Undo. Ale zase by sme mohli skopírovať celú bunku (koment, formát, rám, písmo, ...)
Function ZRKADLI_BUNKU(Zdroj As Range, Ciel As Range) As Variant
Application.Volatile
On Error Resume Next
ZRKADLI_BUNKU = Zdroj.Value 'hodnota zo zdroja do cieľa
If Not Zdroj.Comment Is Nothing Then 'ak má zdroj komentár tak ho skopíruj do cieľa
If Ciel.Comment Is Nothing Then 'ak cieľ nemá komentár, tak ho vytvor
Ciel.AddComment Text:=Zdroj.Comment.Shape.TextFrame.Characters.Text
Else 'ak cieľ má komentár, tak ho zmeň
Ciel.Comment.Text Text:=Zdroj.Comment.Shape.TextFrame.Characters.Text
End If
Else 'ak zdroj komentár nemá, ale cieľ áno, tak ho zmaž
If Not Ciel.Comment Is Nothing Then Ciel.Comment.Delete
End If
End Function
V prípade UDF funkcie musí prísť k prepočtu, teda samotná zmena zdrojového komentu nevyvolá zmenu cieľového komentu. Až zmena nejakej hodnoty v zošite vyvolá prepočet a zmenu.
Uveďte presnejší popis + príklad.
Na posledný záznam podľa A? Alebo na posledný záznam zvoleného oddelenia? Pretože ak iba na posledný záznam v A, tak výberový zoznam v K2 nemá pre operáciu význam. A čo má spustiť tento krok? Zmena v bunke K2?
EDIT:
Na to ako som to pochopil, by sa dal zneužiť vzorec v EVALUATE 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, LST As String
Set Zmena = Intersect(Range("K2"), Target)
If Not Zmena Is Nothing Then
With Range(Range("A24"), Cells(Rows.Count, "A").End(xlUp))
LST = .Parent.Name
On Error Resume Next
Cells(Evaluate("=LOOKUP(2,1/('" & LST & "'!" & .Offset(0, 8).Address & "='" & LST & "'!" & Zmena.Address & "),ROW('" & LST & "'!" & .Address & "))"), "A").Select
End With
End If
End Sub
Tak moment, moment...
Veď to počíta správne. Skontrolujte si tento súbor. Hodnoty som si tam pomenil. Vpravo som manuálne vyrobil tabuľku, aké by mali byť výsledky (bez prepočítavania Excelom). Vo Vašej tbl sú 3 druhy vzorcov, a všetky počítajú tak, ako by to číslo na 15-om desatinnom mieste ani nebolo. Pridal som Podmienené formáty, ktoré očervenejú, ak výsledok nesedí. Máte v tých počítaných stĺpcoch H, I, J niečo červené ?
Tak uvidíme, kde je ten pes zakopaný. Dúfam, že som myslel na všetky možné eventuality:
Sub Click()
Dim Nazev_Stlaceneho_Obrazku As String
Dim Link_Stranky As String
Dim Adresa_Bunky_Pod_Obrazkem As String
On Error Resume Next
Nazev_Stlaceneho_Obrazku = Application.Caller
If Nazev_Stlaceneho_Obrazku = "" Then MsgBox "Makro nebylo spuštěno kliknutím na obrázek nad linkem.", vbExclamation: Exit Sub
With ThisWorkbook.ActiveSheet.Shapes(Application.Caller)
Adresa_Bunky_Pod_Obrazkem = .TopLeftCell.Address(0, 0)
Link_Stranky = .TopLeftCell.Value
End With
If Link_Stranky = "" Then MsgBox "Pod obrázkem """ & Nazev_Stlaceneho_Obrazku & """ v buňce " & Adresa_Bunky_Pod_Obrazkem & " není vyplněný link.", vbExclamation: Exit Sub
On Error GoTo CHYBA
ThisWorkbook.FollowHyperlink Address:=Link_Stranky
Exit Sub
CHYBA:
MsgBox "Jiná neošetřená chyba", vbExclamation
End Sub
Vskutku. Excelu totiž namiesto
99,5 - 99,3 = 0,2
vychádza
99,5 - 99,3 = 0,200000000000003
Treba vymyslieť nejakú fintu, ako ho prinútiť počítať správne. Nepomáha ani zaokrúhlenie dole pomocou FLOOR(C4-B4;0,1). SUMIF, SUMPRODUCT, ale aj matica aj tak vyhodnotí 0,200000000000003.
Hmmm...
Koľko tam môže bežne nastať desatinných miest v C a B?
Tam treba urobiť aj opatrenia na čo najmenší počet možných zlyhaní a omylov. Príklad.
V tom prípade by mal byť ten vzorec v poriadku, akurát že Vy hovoríte o zľave a ja tam čítam slová o pokute
Riadok 8.
Nasmlouvané SLA 99,5
Skutečné SLA 99,7
Je 0,2 nad nasmlouvaným. Bude pokuta???
Raidok 4.
Nasmlouvané SLA 99,5
Skutečné SLA 99,3
Je -0,2 pod nasmlouvaným. Bude pokuta, že!
Tie stĺpce B a C sú čo? To sú už %? Alebo % si má najprv vzorec vypočítať a toto je napr. kapacita (alebo čokoľvek množstevné)?
Ak sú to % a z nich sa berie rozdiel iba pre nesplnené odbery (iba menšie) tak napr.
=IF(C4>B4;A4*IF(C4-B4>=$E$10;$G$10;SUMPRODUCT($G$4:$G$9;(C4-B4>=$E$4:$E$9)*(C4-B4<$F$4:$F$9)));0)
=KDYŽ(C4>B4;A4*KDYŽ(C4-B4>=$E$10;$G$10;SOUČIN.SKALÁRNÍ($G$4:$G$9;(C4-B4>=$E$4:$E$9)*(C4-B4<$F$4:$F$9)));0)
alebo
=IF(C4>B4;A4*IF(C4-B4>=$E$10;$G$10;SUMIFS($G$4:$G$9;$E$4:$E$9;"<="&C4-B4;$F$4:$F$9;">"&C4-B4));0)
=KDYŽ(C4>B4;A4*KDYŽ(C4-B4>=$E$10;$G$10;SUMIFS($G$4:$G$9;$E$4:$E$9;"<="&C4-B4;$F$4:$F$9;">"&C4-B4));0)
Uživatelské menu
\nMenu
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.
RSS nejnovější články