Příspěvky uživatele

?
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "List2" Then
MsgBox "hoj"
End If
End Sub

EDIT: umístit do ThisWorkbook

Evidentně né zcela chápu funkci Tvého řešení, ale v tom případě funkce radek není potřeba viz soubor.

Jedno z možných řešení. Někdo jistě přijde se sofistikovanější variantou.

Tohle by mělo splnit požadavek:
Private Sub Workbook_BeforeSave(ByVal Saved As Boolean, Cancel As Boolean)

Dim PrazdnyRadek As Long
Dim Jmeno As String
Dim rng As Range
Jmeno = Application.UserName

With Worksheets("list1")
Set rng = .Range("A:A").Find(What:=Jmeno, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rng Is Nothing Then
' zapiseme kdy
.Cells(rng.Row, 2) = Now
Else
' prvni prazdny radek
PrazdnyRadek = .Cells(Rows.Count, 1).End(xlUp).Row + 1
' zapiseme kdo
.Cells(PrazdnyRadek, 1) = Jmeno
' zapiseme kdy
.Cells(PrazdnyRadek, 2) = Now
End If
End With

ThisWorkbook.Save
End Sub

Jaj, sorry. Vůbec sem nezaregistroval, že sloupec G neobsahuje vzorec. Upraveno, zadán pevný rozsah G22 až G500.

Kód upraven podle požadavků mimo jedné věci, kterou né zcela chápu.

"Na konci procesu vymazat na listu Objednávky rozsah G22:G500 a zase zamknout list"

Pokud jsou data do listu Objednávky tahána pomocí vzorců, nelze mazat (smažou se vzorce). Jediné co by se dalo vymazat je zdroj dat pro vzorce, tedy v tomto případě List1.

Pokud si to myslel jinak budeš to muset lépe popsat.

Edit: S tím kopírováním jen textových hodnot podle sloupce D. Makro nalezne poslední textový údaj tedy řádek 23. Pokud však bude na řádku např. 30 vracet vzorec textovou hodnotu, a vzorce před ním (řádky 24 až 29) hodnotu "", makro bude kopírovat oblast řádků 22 až 30. Tedy budou do historie uloženy i prázdné hodnoty.

Vše záleží jakým způsobem jsou data zadávána do objednávky. Pokud by se musel ošetřit i tento stav, bylo by potřeba celou objednávku načíst do pole a jednotlivé buňky sloupce D zkontrolovat na nenulovou délku.
De facto celé to znovu přepsat.

Ahoj, vyzkoušej kód v souboru. Jediné co sem neřešil je zobrazování listu "Historie PLÁN", pro vkládání (kopírování) dat to není potřeba. Rozsah kopírované oblasti se určuje podle sloupce D listu "Objednávky". Pokud bude objednávka prázdná (poslední obsazený řádek <22) makro vyhodí hlášku a ukončí se.

Testování případných chyb nechám na Tobě, du chrnět.
Pokud by si přišel na nějakou zradu, dej vědět.

Win 10?
http://pc-help.cnews.cz/viewtopic.php?f=35&t=199453

Tak pokud máš ambice pustit sešit do světa, stálo by za zvážení ošetření vstupních hodnot.
Nemám přesně tušení jak mají vstupní hodnoty vypadat, ale asi by bylo vhodné omezit počty zubů (na nějakou rozumnou hodnotu, aby někoho nenapadlo zadat max počet zubů třeba 600 a pohlídat počet zubů u hodnot min a max aby nebyly vloženy obráceně), počet převodů (tedy dva) zadat jako konstantu do kódu a ošetřit hodnoty zadávané do inputboxu atd.

Sice už sem Elninoslov vložil řešení pomocí pole, ale když už sem se s tím drbal...
Přikládám svůj soubor, defacto je to to samé jako má elninoslov akorát jiný styl zápisu.

Co píše Elninoslov o těch třech převodových stupních je pravda. Při nastavení hodnot zuby - 9, 12 a 3 převodové stupně excel přestal odpovídat (možná je to slabým železem), po přidání breakpointu a krokování sem se dostal na hodnotu přes 250 000 řádků, pak mě to přestalo bavit.

Nebo řešení pomocí pole.
Aby nedocházelo k problikávání obrazovky, stačí odstanit apostrof (') před řádkem Application...
Řádek jsem zakomentoval aby bylo vidět, že se vinka mění.
Do editoru se dostaneš ALT+F11

EDIT: Ještě by to chtělo pohrát si s formátem buněk. Předposlední vin je "delší" a dochází k "vytištění" prázdné stránky.

takto?

Edit:
Teď sem kouknul na první příspěvek a vzorec tam již máš. Stačí změnit hodnoty, které si přeješ zobrazit.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje