Maintenant que vous venez de créer un fichier de présentation PowerPoint, alors qu’il est toujours ouvert, supposons que vous souhaitiez copier une plage de feuilles de calcul dans la première diapositive de cette présentation. La macro suivante utilise une InputBox pour que l’utilisateur sélectionne une plage à copier.
Sub CopierPlage()
' Déclarez une variable de type Range.
Dim maPlage As Range
' Utilisez une Application InputBox pour que l'utilisateur
' sélectionne la plage souhaitée.
'Quittez la macro si l'utilisateur annule.
On Error Resume Next
Set maPlage = Application.InputBox("Sélectionnez une plage à copier:", Type:=8)
If Err.Number <> 0 Then
Err.Clear
MsgBox " Vous n'avez pas entré de plage.", vbInformation, " Annulé "
Exit Sub
End If
' Vérifier la taille de la plage afin d’éviter une plage très large.
If maPlage.Columns.Count > 6 Or maPlage.Rows.Count > 20 Then
MsgBox " Vous avez sélectionné une plage trop grande." & vbCrLf & _
" Veuillez sélectionner une plage qui ne contient pas plus de " & vbCrLf & _
"6 colonnes et / ou 20 lignes.", vbCritical, "Plage trop grande!"
Exit Sub
End If
' Déclarez les variables d'objet.
Dim powerpApp As Object, powerpPres As Object, powerpSlide As Object
'Attribuez l'application PowerPoint dans laquelle vous travaillez
'à la variable powerpApp.
Set powerpApp = GetObject(, "Powerpoint.Application")
' Attribuez le fichier de présentation dans lequel vous travaillez.
Set powerpPres = powerpApp.ActivePresentation
Set powerpSlide =
powerpPres.Slides(powerpApp.ActiveWindow.Selection.SlideRange.SlideIndex)
' Copiez la plage sous forme d'image.
maPlage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' Collez l'image de la plage sur la diapositive.
powerpSlide.Shapes.Paste.Select
' Alignez l'image de plage pour qu'elle soit centrée dans la diapositive.
With powerpApp.ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With
' Libérez la mémoire système réservée aux variables Object.
Set maPlage = Nothing
Set powerpApp = Nothing
Set powerpPres = Nothing
Set powerpSlide = Nothing
End Sub