FAQ PowerPoint

        Presentation("MaPres").Slides.Count
        

        Presentation("MaPres").Slides(1).Export "c:\madiapo", "JPG"
        

Private Sub CommandButton1_Click()
        Dim NomImage As String

        NomImage = "C:\imageTemp.jpg"
    
        'Supprime l'image si elle existe déja
        If Dir(NomImage) <> "" Then Kill NomImage
     
        'Exporte le 1er Slide au format image
        ActivePresentation.Slides(1).Export NomImage, "jpg"
        End Sub

Sub changecolor ()
        Activepresentation.slides(numero de ta diapo).shapes(numero de ton image).Fill.Forecolor.RGB = RGB(255, 0, 0)
        end sub

Dim Obj As Shape
        Dim Resultat As String

        For i = 1 To ActivePresentation.Slides.Count

        For Each Obj In ActivePresentation.Slides(i).Shapes
          If Obj.Type = msoOLEControlObject Then
             If Obj.OLEFormat.ProgID = "Forms.CheckBox.1" Then
                Resultat = Resultat & ActivePresentation.Slides(i).Name _
                & " / " & Obj.Name & " / " & Obj.OLEFormat.Object.Value & vbCrLf
             End If
          End If
        Next Obj

       Next i

       MsgBox Resultat
       End Sub

'expression.InsertFromFile(FileName, Index, SlideStart, SlideEnd)
         'Cet exemple montre comment insérer les diapositives 1 à 4 provenant
         'de "maPresentation2.ppt", à la suite de la diapositive 2 dans la présentation "maPresentation1.ppt"

         Sub InsereDiapositives()
         Dim pptDoc As Presentation

         Set pptDoc = Application.Presentations.Open(FileName:="C:\maPresentation1.ppt")

         'expression.InsertFromFile(FileName, Index, SlideStart, SlideEnd)
         'Cet exemple montre comment insérer les diapositives 1 à 4 provenant
         'de "maPresentation2.ppt", à la suite de la diapositive 2 dans la présentation "maPresentation1.ppt"
         pptDoc.Slides.InsertFromFile "C:\maPresentation2.ppt", 2, 1, 4
         End Sub

Sub Defile()
    Dim i As Integer
        Dim x As Long
        
        For i = 1 To Ppp1.Slides.Count
            x = x + Ppp1.Slides(i).SlideShowTransition.AdvanceTime
        Next i
        
        MsgBox x
End Sub

Sub OnMouveMouse()
    With ActivePresentation.Slides(1) _
        .Shapes(3).ActionSettings(ppMouseOver)
            .Action = ppActionRunMacro
            .Run = "NomMacroDeclenchee"
            .AnimateAction = True
    End With
End Sub

Sub MasquerPPT()
    Dim pptDoc As Presentation
    Set pptDoc = Application.Presentations.Open("C:\maPresentation.ppt", WithWindow:=msoFalse)
End Sub

          Largeur = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.BoundWidth
          Hauteur = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.BoundHeight
          

        Sub Liaisons()
          For Each sld In ActivePresentation.Slides
            For Each Forme In sld.Shapes
              If Forme.Type = msoLinkedOLEObject Then
              Forme.LinkFormat.AutoUpdate = ppUpdateOptionManual
              End If
            Next
          Next
        End Sub
        

Sub TempsMax()
        HeureFermeture = Now + TimeValue("00:00:10")
        While Now < HeureFermeture 
          With ActivePresentation.SlideShowSettings
             .ShowType = ppShowTypeSpeaker
             .LoopUntilStopped = msoTrue
             .ShowWithNarration = msoTrue
             .ShowWithAnimation = msoTrue
             .RangeType = ppShowAll
             .AdvanceMode = ppSlideShowUseSlideTimings
             .PointerColor.RGB = RGB(255, 0, 0)
             .Run
          End With
        Wend
        ActivePresentation.Close
        End Sub
        

        Private Sub CommandButton1_Click()
          ActivePresentation.Close
        End Sub
        

        Dim xlApp As Excel.Application
        Dim xlBook As Excel.Workbook
        'J'initialise mes variables
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = xlApp.Workbooks.Open("D:\Documents\PERSO\truc.xls")

        xlApp.Visible = True

        xlBook.Sheets("Feuil1").Select 
        

        Private Sub CommandButton1_Click()
           Select Case TextBox1
             Case "Blanc", "blanc", "Blanche", "blanche"
               SlideShowWindows(1).View.GotoSlide (7)
             Case Else
               SlideShowWindows(1).View.GotoSlide (6)
           End Select
        End Sub
        

        Private Sub CommandButton1_Click()
        UserForm1.Show
        End Sub
        

        Option Explicit
 
        Dim nomImage As String
 
        Private Sub UserForm_Initialize()
           nomImage = "C:\imageTemp.jpg"
           'supprime l'image si elle existe déja
           If Dir(nomImage) <> "" Then Kill nomImage

           'exporte le 1er Slide au format image
           '(correspond au slide A dans ton projet )
           ActivePresentation.Slides(1).Export nomImage, "jpg"
           DoEvents
 
          'affiche l'image dans l'USF
          With Me.Image1
               .Picture = LoadPicture(nomImage)
               .PictureSizeMode = fmPictureSizeModeStretch
          End With
        End Sub
 
        Private Sub UserForm_Terminate()
          'supprime l'image lors de la fermeture de l'USF
          If Dir(nomImage) <> "" Then Kill nomImage
        End Sub
        

        SendKeys "%{F4}"
        pause = 0.25
        start = Timer
        Do While Timer < start + pause
            DoEvents
        Loop
        SendKeys "{NumLock}"
        GenerationSite.Hide
        

Public WithEvents App As Application

Dim X As New GestionEvents
Private Sub CommandButton1_Click()
        Set X.App = Application 
        SlideShowWindows(1).View.Next 'Passer à la diapositive suivante
End Sub

Public WithEvents App As Application
'
' L'événement traité sur la sortie de powerpoint
'
Private Sub App_PresentationClose(ByVal Pres As Presentation)
     MsgBox "Au Revoir"
End Sub
        
'
' Un autre exemple d'événement :
'
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
  MsgBox Wn.View.Slide.Name
End Sub

Public Sub RenommerShapes()
    '=======================================================================================
    ' Procedure    : RenommerShapes
    ' Auteur       : Philippe JOCHMANS - http://starec.developpez.com
    ' Date         : 19/04/2008
    ' Commentaires : Cette procédure va permettre de renommer les shapes de slides
    '=======================================================================================
    
    ' ===== déclaration des variables =====
    Dim objSld As Slide         ' va permettre de parcourir les diapositives du diaporama
    Dim objShp As Shape         ' va permettre de parcourir les éléments d'une diapositive
    Dim strNom As String        ' pour récupérer le nouveau nom
    Dim strMessage As String    ' message qui sera affiché dans la boite de demande du nom
    
    ' ===== boucle ======
    ' on boucle sur l'ensemble des diapositives
    For Each objSld In ActivePresentation.Slides
        objSld.Select
        ' on boucle sur l'ensemble des shapes
        For Each objShp In objSld.Shapes
            ' création du message qui indiquera slide + shape
            objShp.Select
            strMessage = "Elément sélectionné :" & vbCrLf & _
                         "- Slide : " & objSld.Name & vbCrLf & _
                         "- Shape : " & objShp.Name
            strNom = InputBox(strMessage, "Modification des noms", objShp.Name, 0, 0)
            ' contrôle du nom
            ' si on supprime le nom, on reprend l'ancien
            If strNom = "" Or IsNull(strNom) Then
                strNom = objShp.Name
            End If
            objShp.Name = strNom
        Next objShp
    Next objSld
End Sub

Public Sub AffichageBulleForm(shpSelect As Shape)
    ' ===== déclaration des variables =====
    Dim shpBulle As Shape   ' il s'agit de l'info-bulle qui sera crée
    Dim sldParent As Slide  ' il s'agit d'une slide (diapositive ou se trouve la forme
    Dim t As Date           ' va servir pour la temporisation de l'affichage de l'info-bulle
    
    ' ===== affectation =====
    ' on récupére le slide
    Set sldParent = shpSelect.Parent
    
    ' ===== on crée la bulle =====
    
    Set shpBulle = sldParent.Shapes.AddShape(msoShapeRectangle, shpSelect.Left + shpSelect.Width, shpSelect.Top, 100, 100)
    With shpBulle
        .Name = "Bulle"
        ' couleur de fond
        .Fill.ForeColor.RGB = RGB(150, 150, 120)
        ' texte de la bulle
        .TextFrame.TextRange.Text = "toto"
        .TextFrame.WordWrap = msoTrue
        ' la forme s'adapte au texte
        .TextFrame.AutoSize = ppAutoSizeShapeToFitText
        ' couleur de la ligne
        .Line.ForeColor.RGB = RGB(200, 200, 100)
        ' position
        .Top = shpSelect.Top + 10
        .Left = shpSelect.Left + 10
    End With
    
    ' ===== on lance la temporisation ====
    t = Timer + 1
    Do Until Timer > t
        DoEvents
    Loop
    
    ' ===== on détruit la bulle =====
    sldParent.Shapes("Bulle").Delete
End Sub

Application.DisplayAlerts = ppAlertsAll