Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem PP makro: automatické počítání dnů bez nehody

Zdravím,

obracím se na Vás s prosbou ohledně tvorby makra pro automatické počítání dnů bez nehody. Mám prezentaci, jež neustále běží na LCD a v této prezentaci se zobrazuje právě počet dní bez pracovního úrazu. Jedná se tedy o fixní datum, které se mění cca jednou ročně. A mně jde právě o to, aby se ukazoval rozdíl od tohoto data do aktuálního.

Napadají mě dvě možnosti: buď se bude datum odečítat vždy od aktuálního data a nebo se stanoví hodnota k nějakému datu a každý den se jen připočte 1. Bohužel, jak jsem již řekl, prezentace běží 24/7, tzv. nevypíná se, takže to musí být zcela zautomatizované.

Problém však vidím v jedné věci, na počítači, na němž prezentace běží není MS Office - prezentace na něm beží tedy v prezentačním módu. Nejsem si jistý, zda to za těchto okolností vůbec půjde zrealizovat.

Předem děkuji za nápady a snahu.

Předmět Autor Datum
Najjednoduchšie je prirátať +1 pri zmene dátumu. Na toto zamestnávate jeden počítač + licenciu na MS…
sakraforte 10.04.2014 13:25
sakraforte
Ano, toto obstarává jeden AiO počítač. Licence office, jak jsem již psal, není jeho součástí a ani n…
Spyke 10.04.2014 13:34
Spyke
Namiesto cyklu použí Application.OnTime. Nebudeš tak zbytočne vyťažovať CPU. Ja by som na to použil… poslední
los 10.04.2014 19:38
los

Ano, toto obstarává jeden AiO počítač. Licence office, jak jsem již psal, není jeho součástí a ani nebude, což je nyní celkem zřejmé. Na netu jsem nalezl pár skriptů, ale ani jeden zcela nefungoval. Proto se také obracím na Vás, zdá se totiž, že to nebude taková hračka, jak jsem čekal.

Př.1:

Sub DaysSinceIncident()
    Dim currentDate As String
    Dim lastDate As String
    Dim currentDays As Long
    lastDate = "04/10/2014"
    currentDays = InputBox("365")
    While True
        currentDate = Date
        If currentDate <> lastDate Then
            currrentDays = currentDays + 1
            lastDate = currentDate
            ActivePresentation.Slides(1).Shapes("Number of Days").TextFrame.TextRange.Text = currentDays
        End If
        DoEvents
    Wend
End Sub

Př.2:

Dim lastDate As String
    Dim injfree As Integer
    Dim BnrMsg As String
Sub UpdateBannerText()
    injdate = InputBox("mm/dd/yyyy")
    lastDate = injdate
    injfree = DateDiff("d", injdate, Now)
    BnrMsg = injfree
    ActiveWindow.Selection.ShapeRange(1).TextFrame.TextRange.Text = BnrMsg
End Sub
Sub ResetDate()
    injfree = DateDiff("d", lastDate, Now)
    BnrMsg = injfree
    ActiveWindow.Selection.ShapeRange(1).TextFrame.TextRange.Text = BnrMsg
End Sub

Zpět do poradny Odpovědět na původní otázku Nahoru