Příspěvky uživatele

No skúste

V tom prípade by malo stačiť iba vymeniť slovo
List2
za slovo
ActiveSheet

Upravil som makro vyššie. Ak tam nechcete mať počítaný INDEX na bunku, tak sa dá makrom vytvoriť iba pole odkazov na dané bunky.
Pr.
Sub makro3()
Dim i As Long, Radku As Long, Posun As Long, Vzorce()
With Worksheets("mrp")
Radku = .Cells(Rows.Count, "A").End(xlUp).Row - 1
ReDim Vzorce(1 To Radku, 1 To 2)
For i = 1 To Radku
Posun = Int((i - 1) / 4) * 4
Vzorce(i, 1) = "=B" & 5 + Posun
Vzorce(i, 2) = "=B" & 4 + Posun
Next i
.Range("AJ2").Resize(Radku, 2).Formula = Vzorce
End With
End Sub
alebo jednoduchšie takto:
Sub makro4()
With Worksheets("mrp")
.Range("AJ2:AK5").Formula = Application.Transpose(Array(Array("=B5", "=B5", "=B5", "=B5"), Array("=B4", "=B4", "=B4", "=B4")))
posledni_radek = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("AJ2:AK5").AutoFill Destination:=.Range("AJ2:AK" & posledni_radek), Type:=xlFillDefault
End With
End Sub

Tak B4 alebo B5? Vo všetkých bunkách AJ rovnaký odkaz? alebo vždy "riadkovanie" v AJ po 4-och riadkoch s odkazom na B4, ďalšie 4 riadky na B5, ďalšie 4 na B6, ...
Vyrobte prílohu, kde MANUÁLNE vypíšte vzorce, aké tam chcete mať.
Pr.
Sub makro2()
With Worksheets("mrp")
posledni_radek = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("AJ2").Resize(posledni_radek - 1, 2).Formula = Array("=INDEX($B:$B,5+INT((ROW()-2)/4)*4)", "=INDEX($B:$B,4+INT((ROW()-2)/4)*4)")
End With
End Sub

Všetko záleží na mnohým veciach. Vyhodnotiť môžete v Initialize a zrušiť po Wait v Activate. Formulárové prvky meníte z makier v Moduloch alebo v Module Formu? Príklad uvarený z vody. Proste si vymýšľam, keď nedáte prílohu. Takto to funguje asi ako chcete, za predpokladu, že chcete z vody varené...
Stačí? Prispôsobíte si to?

V čom je presne problém ???

No a kedy teda platí

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

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje