Já to tedy moc nechápu z toho příkladu 
Při spuštění UF se načte poslední řádek do TB1
a pak při každé změně na listu.
Toto umísti do modulu listu
Private Sub Worksheet_Change(ByVal Target As Range)
 Call hodnotatextboxu
End Sub
Toto do obyčejného modulu
Sub hodnotatextboxu()
 UserForm1.TextBox1 = Cells(Rows.Count, "A").End(xlUp).Row
End Sub
A toto do formuláře
Private Sub UserForm_Initialize()
 Call hodnotatextboxu
End Sub
Pokračování tady 
http://wall.cz/index.php?m=topic&id=17487
Buď použít pomocný sloupec nebo tak jak si dělal.
Ty data tam od někud vkládáš?
Patří zároveň k tomuto tématu.
http://wall.cz/index.php?m=topic&id=17486
Příště není potřeba zakládat nové téma, stačí dát odpovědět.
Není tam osetreno kdyby nekdo zadal 5smenu na zacatku (místo za 4 tak pred 1)
Stačí upravit název listu kam se budou kopírovat prohřešky.
Umístit do modulu listu mesice.
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim smena As Byte, pocetsmen As Byte
 Dim listprohresku As Object, radekprohresku As Integer
 
 '***** test zda je ranni po nocni
 If Cells(Target.Row, 1) = "R" And Target.Value = "x" And Target.Offset(1, -1).Value = "x" Then
 MsgBox "Nelze zadat ranní smenu po nocní !!! ", vbCritical
 With Application
 .EnableEvents = False
 .Undo
 .EnableEvents = True
 End With
 End If
 '***** test zda 5 smen za sebou
 If Target.Value = "x" Then
 For smena = 1 To 4
 If Cells(Target.Row, Target.Column - smena) = "x" Then
 pocetsmen = pocetsmen + 1
 End If
 Next smena
 
 If pocetsmen = 4 Then
 If MsgBox("Pátá smena za sebou!! " & vbNewLine & vbNewLine & "Chcete ponechat?", vbInformation + vbYesNo) = vbNo Then
 With Application
 .EnableEvents = False
 .Undo
 .EnableEvents = True
 End With
 Else
 Set listprohresku = Sheets("jmenolistu")
 radekprohresku = listprohresku.Cells(Rows.Count, "A").End(xlUp).Row + 1
 listprohresku.Cells(radekprohresku, 1) = Cells(Target.Row, "B")
 listprohresku.Cells(radekprohresku, 2) = Cells(4, Target.Column) & "." & Format(Cells(3, "B"), "mm") & "." & Cells(4, "B")
 End If
 End If
 End If
End Sub
Asi bych tam dal
If ComboBox1 <> "" Then 'Revizní dvířka
neb chceš kontrolovat jestli je něco vybráno v ComboBoxu.
Pokud tomu tak není tak čeho chceš dosáhnout tím TRUE?
Chtělo by to přílohu, osobně s tím zkušenost nemám.
Chtělo by to nějaká data, takto nevím.
Něco málo umím v Excelu, ale že bych byl génius, to určitě ne.
Když můžu pomůžu. Jsou tací co za to něco i dají nebo chtějí dát, ale to vše záleží na zadavately. Kolikrát potěší jen poděkování.
Dělám to ve volném čase abych si trochu odpočinul od jiného programování.
Do Prehledu natáhne vše z Evidence.
Osobně bych zrušil to vlastní formátování buňek a vše psal makrem.
Vlož do modulu listu Evidence
Sub PrevodDoEvidence()
 Dim radek As Integer, radekshPrehled As Integer
 Dim shPrehled As Object
 Set shPrehled = Sheets("PREHLED")
 radekshPrehled = 3
 For radek = 4 To Cells(Rows.Count, 1).End(xlUp).Row
 shPrehled.Cells(radekshPrehled, "A") = Cells(radek, "A")
 shPrehled.Cells(radekshPrehled + 1, "A") = Cells(radek, "U")
 shPrehled.Cells(radekshPrehled + 2, "A") = Cells(radek, "V")
 shPrehled.Cells(radekshPrehled, "C") = Cells(radek, "B")
 shPrehled.Cells(radekshPrehled + 1, "C") = Cells(radek, "N") & ", " & Cells(radek, "O")
 shPrehled.Cells(radekshPrehled + 2, "C") = Cells(radek, "I")
 shPrehled.Cells(radekshPrehled, "E") = Cells(radek, "CT")
 shPrehled.Cells(radekshPrehled + 1, "E") = "ODPRACOVAL:" 'nevim zda je potreba vzorce
 shPrehled.Cells(radekshPrehled + 1, "F") = Cells(radek, "Q")
 shPrehled.Cells(radekshPrehled + 2, "F") = Cells(radek, "R")
 shPrehled.Cells(radekshPrehled, "G") = Cells(radek, "AG")
 shPrehled.Cells(radekshPrehled + 1, "G") = Cells(radek, "Y")
 radekshPrehled = radekshPrehled + 4
 Next radek
End Sub
Chyba bude asi někde jinde, chtělo by to přílohu.
Nikde nebylo psáno, že se má zkopírovat datumpřed každý řádek.
Sub NakopirujDoListu()
Dim radek As Byte
Dim radeklist As Integer
For radek = 9 To 15
If Cells(radek, "B") = "Jízda" Then
radeklist = Sheets("Databáze").Cells(Rows.Count, 2).End(xlUp).Row + 1
Sheets("Databáze").Range("A" & radeklist).Value _
= Range("B3").Value
Sheets("Databáze").Range("B" & radeklist & ":D" & radeklist).Value _
= Range("B" & radek & ":D" & radek).Value
ElseIf Cells(radek, "B") = "Přestávka " Then
radeklist = Sheets("Databáze").Cells(Rows.Count, 6).End(xlUp).Row + 1
Sheets("Databáze").Range("E" & radeklist).Value _
= Range("B3").Value
Sheets("Databáze").Range("F" & radeklist & ":H" & radeklist).Value _
= Range("B" & radek & ":D" & radek).Value
End If
Next radek
End Sub
Třeba takto při inicializacaci
Private Sub UserForm_Initialize()
 For radek = 1 To Cells(Rows.Count, 1).End(xlUp).Row
 ListBox1.AddItem Cells(radek, 1).Value
 ListBox1.Column(ListBox1.ColumnCount - 3, ListBox1.ListCount - 1) = Cells(radek, 2).Value
 ListBox1.Column(ListBox1.ColumnCount - 2, ListBox1.ListCount - 1) = Cells(radek, 3).Value
 Next radek
End Sub
Stačí nastavit počet sloupců v listboxu a pohrát si s šířkou sloupců.
třeba tímto makrem
Sub NakopirujDoListu()
Dim radek As Byte
Dim radeklist As Integer
 For radek = 9 To 15
 If Cells(radek, "B") = "Jízda" Then
 
 radeklist = Sheets("Databáze").Cells(Rows.Count, 2).End(xlUp).Row + 1
 
 Sheets("Databáze").Range("B" & radeklist & ":D" & radeklist).Value _
 = Range("B" & radek & ":D" & radek).Value
 
 ElseIf Cells(radek, "B") = "Přestávka " Then
 
 radeklist = Sheets("Databáze").Cells(Rows.Count, 6).End(xlUp).Row + 1
 
 Sheets("Databáze").Range("F" & radeklist & ":H" & radeklist).Value _
 = Range("B" & radek & ":D" & radek).Value
 
 End If
 Next radek
End Sub
No pro mě je tedy výhodnější mít ty obrázky v sešitě než někde ve složce. Stejně když ty obrázky načteš tak Ti zvětší velikost sešitu když dáš uložit.
Tady pokud říkáš, že budou obrázky do budoucna přibývat tak bys měl, podle mě lepší přehled.
Místo třeba 15MB by měl sešit stejně min. 8MB
Není problém to předělat aby obrázky byly ve složkách, ale určitě bych zachoval nějaké rozdělení podle listů a pak podle umístění.
Stačí na to moje jednoduché makro.
Pokud ten sešit budeš mít pouze ty a nebudeš ho nikam posílat tak třeba to měj ve složkách, ale pokud se sním bude hýbat tak bych ty obrázky nechal v sešitě.
Jinak to určitě zvládneš, stačí mít správně pojmenované obrázky.
 \n
\nOblí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.