• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Zkusil jsem to vzorcem - bude zrejme z prilohy

Zkuste prilozit nejaky vzorovy priklad a treba pozadovany vysledek, protoze z popisu to neni uplne zrejme (tedy alepson mne ne)...

False je spravne, samozrejme, ze to je preklep
Pokud jde o to formatovani – v tom prikladu se pouziva obarveni bunek podle toho, jestli je to sudy nebo lichy mesic – bohužel u tebe nemusi dny jit za sebou (muze byt nejaky vynechany a tim se dva sudy dostanou vedle sebe, coz by znamenalo, ze budou obarveny stejne ikdyz nebudou totozne).
To, o cem mluvil Krapl asi neznam, protože neznam moznost v 2007, jak udelat to, co potřebuješ.

IsEmpty(Target) = false znamena, ze se procedura spusti jen v pripade, ze zmena bunky nebyla takova, co by bunku smazala. Zkratka, kdyz smazes datum, bunky se neseradi (az kdyz datum napises).
S tim odlisenim radku nevim, je tam spousta otazek, co by musely byt zodpovezeny...

Tady jsem udelal to serazovani po ručním zadani data.
K tomu popisu kodu:
je to udelane přes cyklus For-Next (i=2 to 4), kde Controls(i) jsou Checkboxy, kde jsou zaškrtnuté (nebo nezaškrtnuté) STROJe.
stroj_row = Application.WorksheetFunction.Match(Pridat_NZ.Controls.Item(i).Name, List1.Range("a:a"), 0) = do tehle promenne se uklada pozice STROJe na listu Vyroba, ke které se pak pricita počet radku (u ranni smeny 6, u odpoledni 12).

Cells().end(xlup) nalezne první neprazdny radek od zadane bunky smerem nahoru, takze například List1.Cells(List1.Cells(stroj_row + 6, 1).End(xlUp).Row + 1, 1) je první neprázdna bunka v 1 sloupci pro i-ty STROJ v ranni smene.
K tomu zvýrazněni bunek – to moc nechapu, proc to chces delat, když to není na nicem zavisle(aby se to delalo podminenym formatem), když se budou jen stridat barvy, tak v tom budes mit spis hokej (neboť o muzes udelat natvrdo, když se to nemá menit).

co takhle?

opet jsem upravil kod vyse...

upravil jsem puvodni kod (viz vys)

Pokud je list jen Hidden – lze ho zobrazit primo z excelu, je-li ale VeryHidden – lze ho zobrazit jen kodem nebo prave z VBAProjects, kde je ovšem viditelny.
Jedinou moznosti je uzamknout pristup do projektu heslem!

melo by to fungovat - zkus to a uvidis :)

zkuste to ted, upravil jsem puvodni kod

Vlozte tento kod do modulu Listu1 - zpusobi to spusteni makra HIDE pri zmene bunky M3
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$3" Then
Call hide
End If
End Sub

Mozna jsem to nepochopil spravne, ale nsledujici kod vybere pozadovanou oblast a zobrazi dialog tisku s nastavenim na tisk vyberu.
Sub tisk()
Dim tisk As Variant
Range(Cells(10, 13), Cells(Cells(65000, 13).End(xlUp).Row, 30)).Select
tisk = Application.Dialogs(xlDialogPrint).Show(, , , , , , , , , , , 1)
End Sub

Beru to tak, ze makro funguje (ikdyz při skryvani pomalu – s tim toho moc nenadělám…)
Pokud jde o zpusob spusteni makra – lze makro spustit na zaklade zmeny jedne konkretni bunky nebo jedne bunky z nejake oblasti, nelze však spustit makro v zavislosti na zmene dvou bunek – navrhoval bych spustit makro při zmene M3 – je však nutne, aby uzivatel nejdřív zmenil bunku J3 a az pote M3 – bude to tak vyhovovat?

slo by to mozna takto:Sub kopirovani()
Application.ScreenUpdating = False
For i = 2 To List1.Cells(65000, 12).End(xlUp).Row
If List1.Cells(i, 12) <> List1.Cells(i - 1, 12) Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = List1.Cells(i, 12)
End If
If Worksheets.Count > 1 And IsEmpty(Worksheets(Worksheets.Count).Cells(1, 1)) = True Then
j = List1.Range("L:L").Find(List1.Cells(i, 12)).Row
Do Until List1.Cells(j, 12) <> List1.Cells(i, 12)
j = j + 1
Loop
List1.Select
List1.Range("a1:o1").Copy
Worksheets(Worksheets.Count).Select
Worksheets(Worksheets.Count).Range("a1").Select: ActiveSheet.Paste

List1.Select
List1.Range(Cells(List1.Range("L:L").Find(List1.Cells(i, 12)).Row, 1), Cells(j - 1, 15)).Copy
Worksheets(Worksheets.Count).Select
Worksheets(Worksheets.Count).Cells(Worksheets(Worksheets.Count).Cells(65000, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValue
ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address
ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
ActiveSheet.UsedRange.BorderAround Weight:=xlMedium
End If
Next i
Application.ScreenUpdating = True
End Sub

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse