XL 2016 [RESOLU] Changer application active et au premier plan (Excel / Powerpoint)

Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Boolean

Sub CopierCouleursRemplissage()

'Le document Excel est ouvert et les références Microsoft Excel Object Library et Microsoft Scripting Runtime sont activées

'DEFINITION DES VARIABLES

'Variables globales
Dim xlApp As Excel.Application
Dim xlRng As Excel.Range
Dim FSO As New Scripting.FileSystemObject
Dim AffichageFenetre As LongPtr
Dim AffichagePPT As Double
Dim hwndPPT As LongPtr

'Variables liées au tableau Powerpoint
Dim Forme As Shape
Dim ppTable As Table
Dim Zone As Range 'Plage totale sélectionnée dans Excel (pouvant être discontinue)

'Variables de comptage / boucles
Dim SldIndex As Long 'Numéro de la diapositive active
Dim ZoneNB As Long 'Nombre de zones discontinues constituant la plage Excel
Dim iTotal As Long, jTotal As Long 'Lignes et colonnes dans Powerpoint
Dim i As Long, j As Long 'Lignes et colonnes dans Excel

'VERIFICATION DES PREREQUIS DE LA MACRO

'Extraction du numéro de diapositive active
SldIndex = ActiveWindow.View.Slide.SlideIndex

'Vérification de la présence d'un tableau sur la diapositive active
'via une boucle dans toutes les formes de la présentation active
For Each Forme In ActivePresentation.Slides(SldIndex).Shapes
  If Forme.HasTable Then
    Set ppTable = Forme.Table
    Exit For
  End If
Next

'Si absence de tableau, message d'alerte puis fin de la macro
If ppTable Is Nothing Then
  MsgBox "Aucun tableau dans la diapositive active."
  Exit Sub
End If

On Error Resume Next 'En cas d'erreur dans la création de l'objet

'Crée un objet Excel au sein de Powerpoint
Set xlApp = GetObject(, "Excel.Application")

'Vérifie que l'objet Excel est créé (= Excel est bien ouvert)
If xlApp Is Nothing Then
  'Si Excel n'est pas ouvert: message d'alerte puis sortie
  MsgBox "Microsoft Excel doit être ouvert pour utiliser la macro-commande."
  Exit Sub
Else
End If

'Vérifie s'il existe bien un classeur d'où copier les informations
If xlApp.Workbooks.Count = 0 Then
    'Si aucun classeur ouvert:
    MsgBox "Aucun classeur Excel ouvert." 'Message d'alerte
    xlApp.Quit 'Fermeture de l'application
    Set xlApp = Nothing 'Réinitialisation de l'objet
    Exit Sub 'Fin de la macro
End If

    'SELECTION DE LA PLAGE EXCEL CONTENANT LE FORMAT À COPIER

'Affiche et active le classeur Excel pour sélectionner la plage
AffichageFenetre = SetForegroundWindow(xlApp.Application.hWnd)

On Error Resume Next 'En cas d'erreur dans la saisie ou annulation

'Sélection de la plage à copier depuis Microsoft Excel
Set xlRng = xlApp.InputBox("Sélectionnez la plage Excel :", Type:=8)

'Vérification du contenu de la plage de cellules:
If xlRng Is Nothing Then
  'Si l'utilisateur ne sélectionne aucune plage dans Excel: message d'alerte puis sortie
  MsgBox "Aucune plage sélectionnée."
  Exit Sub
Else
End If

'Retour de l'affichage sur la diapositive active où se situe le tableau :

'xlApp.ActivateMicrosoftApp (xlMicrosoftPowerPoint)
'AppActivate FSO.GetBaseName(ActivePresentation.Name) & " - PowerPoint", False

'Identification du numéro de handle associé à la présentation Powerpoint
'hwndPPT = FindWindow("PPTFrameClass", FSO.GetBaseName(ActivePresentation.Name) & " - PowerPoint")
'AffichageFenetre = SetForegroundWindow(hwndPPT)
'ShowWindow hwndPPT, 10


    'DEBUT DE L'ACTION DE COPIER-COLLER

i = 1

'Partie masquée car message limité à 10 000 caractères
 
'Réinitialisation de toutes les variables objets et plages
Set Zone = Nothing
Set xlRng = Nothing
Set xlApp = Nothing

End Sub