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

[Brain Box]

Bonjour à tous,

Je m'adresse aujourd'hui à la communauté à propos d'un problème assez compliqué puisqu'il s'agit de jongler entre Excel et Powerpoint au sein d'une macro !

C'est une macro assez simple dans son fonctionnement, qui boucle sur une plage de données Excel pour remplir un tableau PPT. Rien de bien extraordinaire, d'ailleurs la macro fonctionne parfaitement. Le problème est ailleurs : la macro démarre dans Powerpoint, le focus passe dans Excel (sélection de la plage via InputBox), les cellules se remplissent, mais impossible de remettre Powerpoint en application active et au premier plan une fois cette macro-commande terminée !

J'ai parcouru les forums (dont celui-ci bien sur ), et je pense avoir essayé beaucoup de choses, sans succès...

J'ai notamment essayé:
- Application.Active (enfin les méthodes apparentées je n'ai plus le nom exact en tête)
- ActivateMicrosoftApp
- AppActivate
- d'autres fonctions Windows (SetForegroundWindow, Shell...)

Je n'ai pas réussi à faire passer cette fichue diapositive au premier plan, donc je dois rater quelque chose. Avec ActivateMicrosoftApp je termine bien sur Powerpoint mais une nouvelle instance s'ouvre, c'est comme s'il considérait que le logiciel n'était pas déjà ouvert...

Je m'en remets à vous pour m'aiguiller sur ce dernier détail qui me fait tourner en bourrique !

Merci beaucoup, et bonnes fêtes à tous

PS : Le dossier ZIP comprend le fichier PPTM ainsi qu'un fichier Excel (sans macro) d'où copier les données.

 

[Staple1600]

Bonjour le fil, le forum

@BrainBox
Peux-tu poster le code de ta macro dans ton message, stp?
(car actuellement je ne dispose que d'un PC avec Office 2003 avec le pack compatibilté installé mais qui semble ignoré les *.pptm)

 

[Brain Box]

Bonjour JM,

Le code est assez long, je voulais donc éviter un message interminable ! Néanmoins, le voici donc à ta demande. J'ai laissé certaines de mes différentes tentatives en commentaire (après "Retour de l'affichage sur la diapositive active où se situe le tableau :").

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

Merci d'accepter de te pencher sur le sujet !

Maxence

 

[Staple1600]

Bonjour le fil, le forum

@Brain Box
Merci pour le code.
Mais actuellement toujours sous Office 2003

Je passe donc le relais à mes petits camarades de jeu du forum avec des versions plus récentes.

 

[Brain Box]

Bonsoir à tous !

Merci JM pour le temps que tu as passé sur mon dossier ! Même si la technique ne te permet pas de m'aider, je ne doute pas que quelqu'un passera par là pour le faire.

Quelqu'un saurait-il voir clair dans ce problème ?

Merci d'avance !

Maxence

 

[Brain Box]

Bonjour tout le monde !

J'ai refait un test grandeur nature aujourd'hui, et allez comprendre pourquoi tout fonctionne comme attendu en utilisant la fonction ShowWindow, que j'avais pourtant déjà testée... (j'ai du rater quelque chose à un moment)

La journée commence bien Je passe donc le titre du topic en 'Résolu'.

Bonne journée à tous !

Maxence