Option Explicit

Sub GenerujPrezentaciAdvanced()
    Dim cesta As String
    Dim txtSoubor As Integer
    Dim radek As String
    Dim nadpis As String
    Dim obsah As String
    Dim poznamka As String
    Dim obrazekCesta As String
    Dim sld As Slide
    Dim obrazek As Shape
    
    cesta = InputBox("Zadej cestu k .txt souboru:", "Generovn prezentace")
    If cesta = "" Then Exit Sub
    
    On Error GoTo Chyba
    txtSoubor = FreeFile
    Open cesta For Input As #txtSoubor
    
    Do While Not EOF(txtSoubor)
        Line Input #txtSoubor, radek
        If Left(radek, 1) = "#" Then
            nadpis = Trim(Mid(radek, 2))
            Line Input #txtSoubor, obsah
            
            poznamka = ""
            obrazekCesta = ""
            
            ' Peti doplkov dky
            Do While Not EOF(txtSoubor)
                Line Input #txtSoubor, radek
                If Left(radek, 1) = "#" Then
                    Seek #txtSoubor, Seek(txtSoubor) - Len(radek) - 2
                    Exit Do
                ElseIf Left(radek, 1) = "@" Then
                    obrazekCesta = Trim(Mid(radek, 2))
                ElseIf Left(radek, 2) = ">>" Then
                    poznamka = Trim(Mid(radek, 3))
                End If
            Loop
            
            ' Vytvo snmek
            Set sld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutText)
            With sld.Shapes(1).TextFrame.TextRange
                .Text = nadpis
                .Font.Bold = msoTrue
                .Font.Color.RGB = RGB(0, 102, 204) ' modr
            End With
            
            sld.Shapes(2).TextFrame.TextRange.Text = obsah
            sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text = poznamka
            
            ' Pechod snmku
            With sld.SlideShowTransition
                .EntryEffect = ppEffectFade
                .Speed = ppTransitionSpeedMedium
                .AdvanceOnTime = msoTrue
                .AdvanceTime = 15 ' posun po 15 sekundch
            End With
            
            ' Animace nadpisu
            With sld.TimeLine.MainSequence.AddEffect(Shape:=sld.Shapes(1), effectId:=msoAnimEffectFade)
                .Timing.TriggerType = msoAnimTriggerAfterPrevious
            End With
            
            ' Animace obsahu
            With sld.TimeLine.MainSequence.AddEffect(Shape:=sld.Shapes(2), effectId:=msoAnimEffectFade)
                .Timing.TriggerType = msoAnimTriggerAfterPrevious
            End With
            
            ' Pidn obrzku + animace
            If obrazekCesta <> "" Then
                If Dir(obrazekCesta) <> "" Then
                    Set obrazek = sld.Shapes.AddPicture(obrazekCesta, _
                        MsoTriState.msoFalse, MsoTriState.msoCTrue, _
                        100, 250, 200, 150)
                    
                    ' Animace obrzku
                    With sld.TimeLine.MainSequence.AddEffect(Shape:=obrazek, effectId:=msoAnimEffectFade)
                        .Timing.TriggerType = msoAnimTriggerAfterPrevious
                    End With
                Else
                    MsgBox "Obrzek '" & obrazekCesta & "' nebyl nalezen.", vbExclamation
                End If
            End If
        End If
    Loop
    
    Close #txtSoubor
    MsgBox "Prezentace byla spn vygenerovna!", vbInformation
    Exit Sub

Chyba:
    MsgBox "Nastala chyba: " & Err.Description, vbCritical
    Close #txtSoubor
End Sub


