Příspěvky uživatele
< návrat zpět
V principu je to tak.
Důležité je dodržet zásadu, že oblast převodové tabulky musí být ve vzorci SVYHLEDAT zadána tak, aby vyhledávací sloupec byl prvním sloupcem nalevo
funkce svyhledat (vlookup). Ta předpokládá, že máš někde převodovou tabulku
Honza;51;10
František;52;8:45
atd.
Mrkni do nápovědy na příklady
Ve svém kódu řeším něco podobného, čili ukládám list jako samostatný soubor. Zde je část, která vymaže všechny Shapes (což jsou třeba tlačítka, obrázky atd,) kromě některých. Rozlišuje se to podle typu Shape.Type
'velikost loga a textboxu se rozhodila, tak ji nastavíme znovu
For i = ActiveSheet.Shapes.Count To 1 Step -1
With ActiveSheet.Shapes(i)
If .Type = 13 Then 'type 13 je logo
.LockAspectRatio = msoFalse
.Height = 20
.Width = 184
ElseIf .Type = 17 Then 'type 17 je textbox
.LockAspectRatio = msoFalse
.Height = 22
.Width = 145
Else 'jinak smazat
.Delete
End If
End With
Next i
Posílám kus kódu, kde vkládám obrázek (shPodpis As Shape) do buňky (rBunka as Range), a to tak, aby obrázek nepřesahoval velikost buňky ani do výšky ani do šířky:
Zamknutí poměru výška/šířka mám úmyslně zakomentované, ale fungovalo to
Set shPodpis = Worksheets("podpisy").Shapes(strJmeno)
Set rBunka = Worksheets("KryciList").Range("E10")
With shPodpis
.Name = strNazev
' .ShapeRange.LockAspectRatio = msoTrue 'uzamknout poměr šířky a výšky
.Top = rBunka.Top + 2
.Width = rBunka.Width - 2 'roztáhni podpis na šířku buňky
If .Height > rBunka.Height Then
.Height = rBunka.Height - 2 'pokud je vyšší než buňka, tak ten podpis zmenši
Else
.Top = rBunka.Top + (rBunka.Height - .Height) / 2
End If
.Left = rBunka.Left + (rBunka.Width - .Width) / 2 'vycentruj to v buňce vodorovně
End With
No tak konečně známe pravý účel makra, který byl na počátku jen mlhavě naznačený.
Tomu by pak odpovídalo i řešení.
No nic ...
Zde inspirace jak to dělat "košér". Snad si to upravíš dle sebe:
Dim strA As String, strB As String
Dim i As Integer, iMax As Integer
Dim ws As Worksheet
ThisWorkbook.Activate
Set ws = Worksheets("List1")
'poslední řádek:
iMax = Application.Max(ws.Range("A65000").End(xlUp).Row, ws.Range("B65000").End(xlUp).Row, ws.Range("C65000").End(xlUp).Row)
'vyskládej text za směnu A
strA = "Směna A:" & vbCrLf
For i = 1 To iMax Step 3
strA = strA & vbTab & ws.Cells(i, "A") & vbTab & ws.Cells(i, "D") & vbCrLf
Next i
'vyskládej text za směnu B
strB = "Směna B:" & vbCrLf
For i = 2 To iMax Step 3
strB = strB & vbTab & ws.Cells(i - 1, "A") & vbTab & ws.Cells(i, "D") & vbCrLf
Next i
MsgBox Prompt:=strA & vbCrLf & strB, Buttons:=vbOK, Title:="Přehled plných směn"
přidal jsem do tvého původního souboru jeden list.
Buď můžeš scrolovat, abys viděl příslušné období, anebo si příslušný měsíc či měsíce zafiltrovat.
A pokud bys to chtěl ještě vidět v nějaké sumární tabulce, to už nebude tak složité.
Plus se to dá dotunit vychytávkami, jak to má lugr. Šlo mi jen o to, že proč se přizpůsobovat nevhodné formě, někde ztažené z Googlu, která byla navržena zřejmě pro jiný případ. I verze co měsíc to nový list jsem historicky opustil už před lety, preferuji data na jednom místě a přizpůsobit jenom způsob jejich zobrazení
No nevím, jestli je šťastné řešení to, co vidím na listě 2021. Tomu se říká Google tabulka? Tedy dost nevhodně navrženo.
Ze zkušenosti bych šel do jiné struktury a to tak, že datumy by byly chronologicky pod sebou (třeba ve sloupci "A") a jednotlivá jména by byla ve čtvrtém řádku (ať to umožní do prvních řádků vložit souhrnné vzorce pro jednotlivé osoby)
A samotné hodnoty (nějaké zkratky pro přítomnost, dovolenku, SV...) by se nacházely v průsečníku daného dne a daného jména.
Předem si dovolím upozornit na chybějící rozměr jak tohoto, tak i "Google" řešení a tím jsou hodiny. Čili jak zaznamenat přesčas nebo 2 hodiny lékař a půl dne dovolené a podobné příklady ze života. V tomto je dobré mít jasno už na začátku.
Běžně používám kód na práci se skrytým listem, čili kopírování, filtrování a podobně. Ty zmiňované chyby mají nějaký kód či popis, třeba že ten skrytý list je ještě zamčený...
odstraněno
Podle popisu to bude něco jako jako databáze (db) osob, kde co osoba to řádek. Předpokládejme že to tak je a že můžeme použít VBA. Jestli ne, tak následující text je k ničemu.
Data bych skladoval na velmi skrytém listě (VeryHidden).
Každá osoba by si určila heslo, na to by se do db přidal extra sloupec (nebo i více sloupců pro skupinové či generální heslo).
Na viditelném listě by bylo tlačítko a po kliknutí by vyskočil přihlašovací formulář s ComboBoxem pro výběr osoby a další textové políčko pro zadání hesla.
Pokud bude shoda s vybranou osobou a příslušným heslem, tak
na viditelný list natáhnu data dané osoby - a to buď do listu anebo do formuláře - záleží co bude vhodnější pro plánovaný účel.
Tož zatím jen tak, jelikož nevím zdali to nerozvíjím nechtěným směrem ...
Ahoj, rád bych se zeptal zdali jste se s tím taky setkali. Jde o to, že po léta fungující makra najednou začínají házet chybu. Všímám si to už tak cca 2 měsíce. Často pomůže úplný restart PC, ale teď část kolegů dostalo nové HP notebooky a tento, naprosto běžný kód hází chybu hned na druhém řádku. Když ho zakometuji, tak chybuje ten další: .Zoom = False
Worksheet wsNew v daném okamžiku existuje a není zamknutý.
Stejně jako strOblastTisku má správnou hodnotu.
With wsNew.PageSetup
.PrintArea = strOblastTisku
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.118110236220472)
.FooterMargin = Application.InchesToPoints(0.118110236220472)
.CenterHorizontally = True
End With
Obešel jsem to přidáním příkazu na ignorování chyby On Error Resume Next, ale docela mně to zaráží.
Napsal jsem tuny procedur a poslední dobou pořád řeším nějaké chyb v kódu, které začaly vyskakovat, ale jenom někdy a jenom na některých PC.
Máte někdo taky podobné zkušenosti?
Ahoj,
mám nějaký svůj výtvor s makrama, která se spouští kliknutím na ikony. Tyto ikony jsem na list vložil normálně přes ribbon Vložení - Ikony.
Chtěl jsem, aby - když se nad ikonu najede myší, tak aby se zobrazil nějaký pomocný text.
Zde: https://www.youtube.com/watch?edufilter=NULL&v=1GvPmzuQ-sU jsem objevil postup - přes hypertextový odkaz.
Zobrazování textu po najetí myši tímto sice začalo fungovat, ale ztratilo se navázání ikony na makro, čili po kliknutí se nic nestane.
Nevíte náhodou někdo jak dosáhnout obojího? Netrvám na ikonách, klidně to mohou být i tlačítka nebo jiné Shapes...
Předem dík
nejde mi připojit soubor, takže makro vypadá takhle:Sub Test_XY()
Dim dtDnes As Date
Dim j As Integer, jMxCol As Integer, jCol As Integer
Dim rBunka As Range
ThisWorkbook.Activate
'poslední sloupec v řádku 2
jMxCol = Range("OO2").End(xlToLeft).Column
'dnes:
dtDnes = Fix(Now())
For j = 2 To jMxCol
Set rBunka = Cells(2, j)
rBunka.Select
If rBunka = dtDnes Then
rBunka.Offset(0, 15).Select 'zde podle velikosti monitoru nastavit skok doprava
rBunka.Select
rBunka.Offset(0, 32).Select 'zde podle velikosti monitoru nastavit skok doprava
' rBunka.Select
Exit For
End If
Next j
End Sub
A zavěsíš to na událost Private Sub Workbook_Open()
Call Test_XY
End Sub
Je to takové kostrbaté, ale nějak tak by to šlo. Akorát si ty odskoky musíš v makru vyladit podle své šířky monitoru.
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články