à partir d'un document Power Point, il est posible d'obtenir des résumés, l'auteur, les titres ...
Source / Exemple :
Public Class diapo
Dim ppApp As PowerPoint.Application
Dim prsPres As PowerPoint.Presentation
Public Sub New()
MyBase.new()
ppApp = New PowerPoint.Application()
End Sub
Public Sub Ouvrir(ByVal nomFichier As String)
With ppApp
.Visible = True
.WindowState = PowerPoint.PpWindowState.ppWindowMinimized
End With
prsPres = ppApp.Presentations.Open(nomFichier, , , True)
End Sub
Public Function Fermer()
prsPres.Close()
ppApp.Quit()
End Function
'''''''''''''''''''''''''''''''''' Slides ''''''''''''''''''''''''''''''''''''''
Public Function NombreSlides() As Integer
NombreSlides = prsPres.Slides.Count
End Function
Sub tNombreSlides()
MsgBox(NombreSlides())
End Sub
Public Function NomSlide(ByVal indice) As String
NomSlide = prsPres.Slides.Item(indice).Name
End Function
Sub tNomSlide()
REM cible = Int(Rnd * NombreSlides + 1)
Dim cible
cible = 51
MsgBox(NomSlide(cible))
End Sub
Public Function TitreSlide(ByVal indice) As String
Dim elementTitre As PowerPoint.Shapes
elementTitre = prsPres.Slides.Item(indice).Shapes
If elementTitre.HasTitle Then
TitreSlide = elementTitre.Title.TextFrame.TextRange.Text
Else
TitreSlide = NomSlide(indice)
End If
End Function
Sub tTitreSlide()
Dim cible
cible = 1
MsgBox(TitreSlide(cible))
End Sub
Function Description(ByVal indice) As String
REM différentes vérifictions (grace aux if)
REM - le nombre de lignes < 5
REM - uniquement du text
REM - des lignes > 1 caractère
REM - ne pas remettre le titre sur la première ligne
Dim element As PowerPoint.Shapes
Dim tampon, nb, e
element = prsPres.Slides.Item(indice).Shapes
tampon = ""
nb = 0
For Each e In element
If nb < 5 Then
If e.HasTextFrame Then
If e.TextFrame.TextRange.Length > 1 Then
If e.TextFrame.TextRange.Text <> TitreSlide(indice) Then
tampon = tampon + e.TextFrame.TextRange.Text & Chr(10) & Chr(13)
nb = nb + 1
End If
End If
End If
End If
Next
Description = tampon
End Function
Sub tDescription()
Dim diapos As PowerPoint.Slides
Dim d
diapos = prsPres.Slides
For Each d In diapos
MsgBox(Description(d.SlideIndex))
Next
End Sub
Function Fiche(ByVal indice, ByVal selection) As String
Dim tampon
If selection = 1 Or selection = 3 Then
tampon = TitreSlide(indice)
tampon = tampon + " << " + NomSlide(indice) + " >>"
tampon = tampon & Chr(10) & Chr(10) & Chr(13)
End If
If selection = 2 Or selection = 3 Then
tampon = tampon + Description(indice)
End If
Fiche = tampon
End Function
Sub tFiche()
Dim diapos As PowerPoint.Slides
Dim d
diapos = prsPres.Slides
For Each d In diapos
MsgBox(Fiche(d.SlideIndex, 3))
Next
End Sub
Sub Ecrire(ByVal Nomfichier As String)
With prsPres.WebOptions
.IncludeNavigation = True
.FrameColors = 1
.ResizeGraphics = True
.ShowSlideAnimation = False
.OrganizeInFolder = True
.UseLongFileNames = True
.RelyOnVML = False
.AllowPNG = False
.ScreenSize = Microsoft.Office.Core.MsoScreenSize.msoScreenSize800x600
.Encoding = 1252
End With
With ppApp.DefaultWebOptions
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = True
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = False
End With
prsPres.SaveAs(Nomfichier, PowerPoint.PpSaveAsFileType.ppSaveAsHTMLv3, False)
End Sub
Sub tEcrire()
Dim Nomfichier As String = "P:\testFctEcrire"
Ecrire(Nomfichier)
End Sub
Function Fichier(ByVal indice As Integer) As String
Dim tampon As String
Dim i As Integer = NomSlide(indice).Length
tampon = NomSlide(indice)
While tampon.Chars(i - 1) <> "e" And i > 1
i = i - 1
End While
tampon = tampon.Substring(i)
While tampon.Length < 4
tampon = "0" & tampon
End While
Fichier = "slide" & tampon & ".htm"
End Function
'''''''''''''''''''''''''''''''''''''' Diapo '''''''''''''''''''''''''''''''''''''
Public Function PropTitre()
If ppApp.ActivePresentation.BuiltInDocumentProperties.item(1).value <> "" Then
PropTitre = ppApp.ActivePresentation.BuiltInDocumentProperties.item(1).value
End If
End Function
Sub tPropTitre()
MsgBox(PropTitre())
End Sub
Public Function PropDescription()
Dim tampon
If ppApp.ActivePresentation.BuiltInDocumentProperties.item(2).value <> "" Then
tampon = ppApp.ActivePresentation.BuiltInDocumentProperties.item(2).value
tampon = tampon + Chr(13) + Chr(10) + Chr(10)
End If
If ppApp.ActivePresentation.BuiltInDocumentProperties.item(5).value <> "" Then
tampon = tampon + ppApp.ActivePresentation.BuiltInDocumentProperties.item(5).value
End If
PropDescription = tampon
End Function
Public Function tPropDescription()
MsgBox(PropDescription())
End Function
Function PropAuteur()
If ppApp.ActivePresentation.BuiltInDocumentProperties.item(3).value <> "" Then
PropAuteur = PropAuteur + ppApp.ActivePresentation.BuiltInDocumentProperties.item(3).value
End If
End Function
Public Function tPopAuteur()
MsgBox(PropAuteur())
End Function
Public Function PropDate()
PropDate = System.DateTime.Now.ToLongDateString()
End Function
Public Function tPropDate()
MsgBox(PropDate())
End Function
Public Function Identifiant() As String
Dim i As Integer
Dim tampon As String
tampon = System.DateTime.Now.ToShortDateString() + PropTitre()
For i = 0 To (tampon.Length - 1)
If tampon.Chars(i) <> "\" And tampon.Chars(i) <> "/" And tampon.Chars(i) <> " " Then
Identifiant = Identifiant + tampon.Chars(i)
End If
Next
End Function
Function ListeTout(ByVal selection As Integer)
Dim Texte(NombreSlides() - 1) As String
Dim i
For i = 0 To (NombreSlides() - 1)
Select Case (selection)
Case 1
Texte(i) = NomSlide(i + 1)
Case 2
Texte(i) = TitreSlide(i + 1)
Case Else
Texte(i) = TitreSlide(i + 1) & " (>-<'` " & NomSlide(i + 1)
End Select
Next
ListeTout = Texte
End Function
End Class
Conclusion :
Pour utiliser la classe, il faut commencer par ajouter la Référence COM "MicrosoftPowerPoint".
Ensuite il faut instancer la classe de manière habituelle en utilisant les fonctions new et Ouvrir(ByVal nomFichier As String).
Et n'oubliez pas la fonction Fermer() à la fin
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.