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

Příspěvky uživatele

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.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse