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.
Děkuji za navržený způsob, který mně inspiroval ke konečnému řešení. Ve finále nakonec stačilo použít Replace přímo do Inputboxu:
sgBanka = Application.InputBox(Prompt:="Zadej počet přesčasových hodin", Default:=Replace(sgPrescasy, ".", ","), Type:=1)
Ahoj, když mám tento příkaz:
sgBanka = Application.InputBox(Prompt:="Zadej počet přesčasových hodin", Default:=sgPrescasy, Type:=1)
a proměnná sgPrescasy není celé číslo (dejme tomu že má hodnoutu 4,5), tak se v inputBoxu zobrazí s tečkou místo čárky a když se zvolí OK, tak mi to do sgBanka načte nesmyslnou hodnotu 43956. Napadá mně to číslo rozbít na celou a desetinnou část a pak textově mezi to dát čárku. Ale jednak tuším, že si tím přidělám další potíže a myslím si, že na to musí být nějaký jednoduchý trik aby to inputbox chápal korektně...
Předem dík
Jenom můj poznatek ze zalamování řádků ve VBA za použití " _"
I toto má své omezení, někde kolem dvacátého zalomení to hlásilo, že dál už to nejde. Dělal jsem to kvůli přehlednosti Array, abych měl jednotlivé prvky pod sebou...
Nevím, jestli to bude fungovat, ale soudě podle následujícího kódu (ten vytvoří z excelu outlookovou zprávu), bych zkusil
OLAppointment.Body = "Zdarec!"
With OutMail
.To = "pacos1@moria.com" 'komu
.CC = "pacos2@moria.com" 'kopie
.Subject = "test odeslání e-mailu" 'předmět
.Body = "Dobrý den, " & vbCrLf & "..." & vbCrLf & "S pozdravem" 'text zprávy
.Attachments.Add "C:\Users\userXY\Documents\utahovací_momenty.pdf"
.Importance = 2 'vysoká důležitost
.Display 'zobrazí to tento e-mail s přílohou bez odeslání
' .Send 'anebo rovnou to odešle
End With
Přikládám.
chvilku mi trvalo než jsem to anonymizoval, neboť bych nerad vystavoval skutečná data.
Normálně platí ten první zaremovaný řádek, neboť cesta k DB bývá konstanta. Pro tuto verzi jsem to udělal jako proměnnou, tak aby umístěním DB byl stejný adresář
'Public Const DataSourcePath As String = "\\brsv002\Servis\Prehled_ND\Prehled_ND.mdb" 'cesta k DB na serveru
Public DataSourcePath As String 'toto je pro verzi, kdy DB je ve stejném adresáři jako tato konzole
Oblí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.