Recherche

Voici une macro à relier à un bouton à installer sur la barre d'outils Accès rapide.

Important : notez que la photo doit avoir les mêmes proportions que vos diapositives. C'est en effet un bug de PowerPoint : si vous modifiez manuellement l'arrière plan à l'aide d'une image, les proportions de cette dernière s'ajusteront à la taille de votre diapositive. La photo pourra donc être coupée de façon à s'adapter à la taille de la diapo mais ne sera jamais déformée.

Malheureusement, avec une macro, ce n'est pas le cas. Bien souvent les entreprises proposent une banque d'images, auquel cas, il n'y a pas de souci, il suffira, en amont, de formater d'un bloc toutes les images au bon format et de diriger le choix dans le dossier qui se trouve sur un serveur par exemple.

La macro suivante vérifie que vous êtes bien sur une page de titre, si ce n'est pas le cas un message vous le rappelle.

Notez que cette macro ne va modifier que l'arrière-plan de la page de titre où se trouve le curseur, et non pas pour tout le thème.

Sub arriereplan()

Dim fd As FileDialog, Image, gauche, haut
If Left(ActiveWindow.Selection.SlideRange.CustomLayout.Name, 20<> "Diapositive de titre" Then
MsgBox "Attention, cette commande n'est prévue que pour la diapositive de titre, celle-ci n'en est pas une. Veuillez insérer la diapositive de titre et la sélectionner."
Exit Sub
End If
On Error GoTo erreur

'ouverture de la boite de dialogue pour choisir une image
Set fd = Application.FileDialog(Type:=msoFileDialogFilePicker)
On Error Resume Next
With fd
    .AllowMultiSelect = False
        If .Show = -1 Then
            Image_t = fd.SelectedItems(1)
        Else: Exit Sub
        End If
End With

On Error GoTo erreur:
    With ActiveWindow.Selection.SlideRange
        .FollowMasterBackground = msoFalse
        .DisplayMasterShapes = msoTrue
        With .Background
            .Fill.Visible = msoTrue
            .Fill.UserPicture Image_t
        End With
    End With

Exit Sub

erreur:
MsgBox "Veuillez sélectionner d'abord la diapo"

End Sub

 

 

 

 

Statistiques

France 72,1% France
Canada 7,7% Canada
Belgique 3,8% Belgique

Total:

117

Pays
018308639
Aujourd'hui: 40
Hier: 386
Cette semaine: 1.369
Semaine dernière: 2.467
Ce mois: 4.031