PowerPoint "Replace fiont"

Lidt inspiration (måske):

VBA-kode er anbragt i et Word dok. Der testes IKKE for p.t. font

Const sti = "C:\Documents and Settings\pb.KHNBPB\Skrivebord\ppFONTS\demo.ppt"
Dim pp
Public Sub ppFonteUdskiftes()
Dim osld As Slide, sh As Shape
    Set pp = CreateObject("PowerPoint.application")
    pp.Visible = True

    With pp.Presentations
        .Open FileName:=sti
        antalDias = pp.ActivePresentation.Slides.Count
    End With
   
    For Each osld In pp.ActivePresentation.Slides
        antalsh = osld.Shapes.Count
       
        For f = 1 To antalsh
            osld.Shapes(f).Select

            If osld.Shapes(f).HasTextFrame = True Then
                fn = osld.Shapes(f).TextFrame.TextRange.Font.Name
                osld.Shapes(f).TextFrame.TextRange.Font.Name = "Stencil"
            End If
        Next f
    Next
End Sub