Je to takové kostrbaté, ale nějak tak by to šlo. Akorát si ty odskoky musíš v makru vyladit podle své šířky monitoru.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Plánovací kalendář
MS Excel
Téma: Plánovací kalendář 
Zaslal/a Whooocak 28.5.2020 22:18
Dobrý den,
rád bych si vytvořil jednoduchý plánovací kalendář, kde bych si zapisoval termíny jednotlivých úkolů. V příloze je tabulka s daty a rozvržení úkolů, kde první sloupec je ukotven. Požadavkem je, aby se při otevření sešitu (na základě aktuálního data) do prvního sloupce posunuly buňky a zobrazilo se aktuální datum.
Př. dnes je 28.5., takže se mi v prvním sloupci zobrazí dnešní datum s pokračováním následujících dní.
Přes podmíněné formátování jsem schopný dnešní datum zvýraznit, ale nevím, jak, nebo jestli vůbec jde celé sloupce posouvat.
Díky Martin
Příloha: 
46735_planovac.xlsx (12kB, staženo 54x)
46735_planovac.xlsx (12kB, staženo 54x)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
citovat
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
citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\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