Příspěvky uživatele

Vidím, že listování záznamy z mé poslední přílohy jsi neimplementoval ale neva.
Uložení původních hodnot záznamu předtím, než uložíš změněné hodnoty (tedy jestli jsem to podle popisu správně pochopil) najdeš v příloze

Přiznám se, že moc těm otázkám nerozumím. Naznačuješ, že ty jednotlivé kroky si implementuješ do svého souboru, ale ten nepřikládáš - asi tam máš nějaká data které nechceš zveřejňovat. Ale tím pádem jsme odkázani na slovní popis, který nese jen část informace plus kognitivní zkreslení.

Buď si ty svoje data nějak anonymizuj či jinak vhodně pozměň, (zachovej datové typy) ale bez přiloženého kompletního souboru je to odsouzeno nezdaru z uondání.

Dim OBLAST1_paste1 As Range
Dim x As Integer

Set OBLAST1_paste1 = Worksheets("List16").Range("C8:C19")
x = 15
OBLAST1_paste1.Value = x

Jasně že tam lze ještě hodně vylepšit - např. zadávání datumu pomocí kalendáře anebo pomocí lomítka (jednou rukou), kontrola zdali je zadaná hodnota opravdu datum atd...
Nebo informační hláška při editaci záznamu, kolik hodnot se chystáš v daném záznamu změnit. Taky v tom svém formuláři zatím nemáš ComboBox, Listbox, OptionButton, CheckBox jakožto užitečné a elegantní vychytávky pro maximalizaci uživatelského komfortu...

Tak soubor v příloze už obsahuje to úplné minimum, které opravdický funkční formulář musí umět, čili umožňuje listovat jednotlivými záznamy a editovat je. V případě, že je na listě nasazený filtr, tak neviditelné řádky ignoruje.

Pro listování bylo potřebné změnit vlastnost formuláře ShowModal na False (i když dalo se to ošetřit i přes ignoraci chyby On Error Resume Next). Toto rovněž umožňuje při otvřeném formuláři kopírovat hodnoty z a do formu, což při ShowModal = True nejde.

Věřím, že přidání poznámky, vyčištění kolonek atd zvládneš sám. Rovněž odstranění záznamu by už neměl být problém. Šak uvidíme... (možná)

To je důvod, proč jsem do formu přidal textbox s informací o číslu řádku.
Doufám, že s verzí 2 už ses seznámil a můžeme přistoupit k verzi 3. Pro účely zjišťování posledního řádku se vyplatí mít extra funkci, která jej spolehlivě najde i v případě, když je v tabulce zapnutý nějaký filtr - takže to tam taky najdeš.
Pro ukládání údajů z formuláře na list používám jednu rutinu, které předávám dva argumenty: číslo řádku a informaci o tom, jestli se jedná o nový záznam anebo editaci existujícího.
Všimni si jaké typy procedur jsou v kódu formuláře (událostní) a že ty volané je lepší mít v samostatném modulu.

Tak fajn. V přiloženém souboru je vyřešené načítání dat z listu do formuláře.
Kód je komentovaný, takže to určitě pochopíš.
Prvky formuláře jsem trochu přejmenoval, aby bylo zřejmé o jaký typ jde (txt... = textbox, btn...= tlačítko) a pak co nese za informaci. Čili txtID je mnohem výstižnější než Textbox4.
Jak si všimneš, u některých prvků jsem měnil vlastnosti.

Až to vstřebáš, tak další částí bude ukládání dat z formu na list

OK, no to bude na dýl.
Jestli rozumím správně vyjádření "ako si uložím do Hárok2 data ešte pred prepísaním ?", tak chceš po vyplnění formuláře uložit data do tabulky. Ale jistotu nemám, mate mně tam to "ešte pred prepísaním".
Slušný form má umožńovat načtení zaznamu z listu do formu, listování jednotlivými záznamy, editaci existujících záznamů a uložení nového. S čím chceš začít?

Posílám v příloze. Zamykání si uprav, s průřezem nejde pracovat při zamčeném listě, tak jsem zamykací ceremonie deaktivoval
V kódu pro list 5, na kterém se ten průřez (angl. Slice) nachází je událostní procedura Worksheet_PivotTableUpdate, která pak volá rutinu VytvorSoubor, které předává název, jaký má vytvořit.
Zbytek si musíš dotvořit dle svých představ, které jsou popsány jenom mlhavě

To je jaksi divně popsáno. Ten lichý/sudý týden určuješ vzorcem v podmíněném formátování anebo podle barev (jak píšeš)? Pokud jsi si na prvním listě poradil s určováním sudého / lichého týdne, tak stejně to můžeš udělat i na těch dalších. Anebo jinak: co ti brání použít nějakou další buňku, která ponese informaci sudý/lichý a podle ní pak nastavíš podmíněné formátování na všech listech?

Šlo by to řešit mnoha způsoby. Kdysi jsem potřeboval vytvořit nový sešit z vyfiltrovaných hodnot. Pokud tam filtr není, tak to vytvoří sešit ze všech hodnot. Ve smyčce se tam upravují i šířky sloupců podle originálu. Zkoušel jsem to a funguje to, případně se to dá volně upravit. Zde je kód:
Sub Kopie_listu_filtr()
'z aktivního listu vytvoří nový sešit s pouze přefiltrovanými řádky

Dim jMxCol As Integer
Dim iMxRow As Long, i As Long, iHlp As Long
Dim sgHlp As Single
Dim wbNew As Workbook
Dim ws As Worksheet, wb As Workbook
Dim strFiltAdr As String, strFormat As String
Dim FiltHelp As Boolean
Dim rgAdresa As String

Set wb = ActiveWorkbook
Set ws = ActiveSheet
rgAdresa = ActiveCell.Address

Application.ScreenUpdating = False

'poslední řádek na aktivním listě
'vyzkoušej prvních 10 sloupců
For i = 1 To 10
iHlp = Cells(65000, i).End(xlUp).Row
If iHlp > iMxRow Then iMxRow = iHlp
Next i

'poslední sloupec na aktivním listě
'vyzkoušej prvních 20 řádků
For i = 1 To 20
iHlp = Cells(i, 250).End(xlToLeft).Column
If iHlp > jMxCol Then jMxCol = iHlp
Next i

''pokud není nasazený Filtr, zeptej se jak dál
' If Not w1.FilterMode Then
' If vbNo = MsgBox("Není zadáno žádné filtrování. Budu tedy kopírovat všech " & iMxRow & " řádků " & vbCr & vbCr & _
' "Mám v akci pokračovat?", vbYesNo) Then Exit Sub
' End If

'zjisti rozměry filtru (pro pozdější nasazení stejného filtru do nového souboru)
If ws.AutoFilterMode Then
strFiltAdr = ws.AutoFilter.Range.Address
iHlp = ws.AutoFilter.Range.Columns.Count
FiltHelp = True
End If

'vytvoř nový soubor
Workbooks.Add
Set wbNew = ActiveWorkbook

'kopíruj řádky
wb.Activate
Rows("1:" & iMxRow).Select
Selection.Copy

'vlož kopírované řádky
wbNew.Activate
Selection.PasteSpecial Paste:=xlFormats
' Selection.PasteSpecial Paste:=xlFormulas
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False

'překopíruj šířku sloupců a formát
For i = 1 To jMxCol
wb.Activate
sgHlp = Columns(i).ColumnWidth
' strFormat = Cells(7, i).NumberFormat

wbNew.Activate
Columns(i).ColumnWidth = sgHlp
' If strFormat <> "@" Then Columns(i).NumberFormat = strFormat
Next i

'pokud tam byl filtr, tak nakopíruj i filtr
If FiltHelp Then
Range(strFiltAdr).Select
Selection.AutoFilter
End If

'zkopíruj nastavení lupy
wb.Activate
sgHlp = ActiveWindow.Zoom
wbNew.Activate
ActiveWindow.Zoom = sgHlp

Application.ScreenUpdating = True

Range(rgAdresa).Select

End Sub

Jak již pravil Komenský, je potřeba postupovat od jednoduššího k složitějšímu. Čili to jednodušší jsem poskytl, je to komentované a věřím, že přehledné.
Tak se do toho ponoř. Kód se krokuje klávesou F8, aktuální hodnoty proměnných se ukazují když na ně najedeš myší.

Pokud některé části kódu nerozumíš, vysvětlím.
Je mnohem lepší si svůj kód umět udržovat a modifikovat sám, než pak při každé změně okolností somrovat hotové řešení. Stejné neomaleně mi to bylo kdysi naznačeno, tak jsem se to raději naučil...

Třeba takhle:
Public Sub EXPORT_Harku_do_textu()

Application.EnableEvents = False
' tento zapis zaisti to, ze bude znemoznene volanie procedur spustenych na zaklade udalosti. Na konci kodu je nutne udalosti znovu 'zapnut'

Dim cesta As String
Dim nove_meno As String
Dim cele_meno As String
Dim zdroj As String

Dim i As Long, iMxRow As Long

iMxRow = Range("E65000").End(xlUp).Row
If iMxRow > 4 Then
For i = 4 To iMxRow
Cells(i, "E") = CStr(Cells(i, "E").Text)
Next i
End If

zdroj = ActiveWorkbook.Name ' nastavenie mena zdroju - meno povodneho zositu
cesta = ActiveWorkbook.Path ' nastavenie cesty pre ulozenie dat - tam kde bol povodny zosit otvoreny
Application.DisplayAlerts = False

ActiveSheet.Copy ' skopiruje cely aktivny harok do noveho zositu
ActiveSheet.Cells.UnMerge ' zrusi zlucenie buniek
Workbooks(zdroj).ActiveSheet.Cells.Copy ' skopiruje povodny harok
ActiveSheet.Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' iba hodnoty skopiruje do noveho harku (aby nekopirovalo pripadne vzorce vsetko potrebujem mat v texte)
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Cells.NumberFormat = "@" ' nastavi format celeho noveho harku do textu, pretoze cely harok musi byt vo formate textu
ActiveSheet.Columns("H").NumberFormat = "0000 000 000"

nove_meno = "Zosit " ' predpis noveho mena
Dim filename As Variant ' nastavenie cesty pre ulozenie
filename = Application.GetSaveAsFilename(nove_meno, "Excel (*.xlsx),*.*,Excel 98-03 (*.xls),*.*,", 1, "Uložiť ako") ' zobrazi sa okno 'ukladania'
If filename = False Then Exit Sub
cele_meno = filename
ActiveWorkbook.SaveAs (cele_meno) ' ulozenie zositu do standartnej cesty ukladania

ActiveSheet.Cells(1, 1).Select ' odklikni oznacenie celeho harku
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.EnableEvents = True ' volanie procedur spustenych na zaklade udalosti 'zapnut'
End Sub

Za splnění podmínky definované v předchozím postu posílám řešení. Je tam jedno tlačítko a email se vygeneruje podle údajů v řádku kde stojí kurzor.
Tlačítko je na listě 02BBB. Do dalších ho stačí jednoduše zkopírovat

Pozn: v původní příloze jsem měl chybku, opraveno

Ta struktura listu osoby je divná.
To by nešlo udělat jako rozumnou tabulku? Kde ve sloupci A by bylo to číslo, ve druhém jméno a ve třetím buď celá e-mailová adresa anebo alespoň jméno bez diakritiky, tak jak to figuruje v adrese.
Pak by to bylo docela snadné

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje