XL 2016 comment créer une Barre de défilement ou faire simplement défiler son texte ?

[melltel]

Bonjour,

Je suis consciente que ce que je demande est peut-être inexistant, mais j'ai une lueur d'espoir.

J'ai deux fichiers Excel et PowerPoint qui collaborent, Excel étant ma base.
Du fichier Excel, j'ai extrait des données texte pour les copier dans PowerPoint dans une zone de texte "espaceCom".

Cependant, le texte extrait est trop grand pour l'espace dédié. Je ne souhaite pas réduire la taille du texte, car il deviendrait illisible, et je ne peux pas non plus augmenter la taille de la zone 'espaceCom'.
Je me suis dit qu'en rendant le texte dynamique avec une barre de défilement ou un petit ascenseur sur le côté, cela pourrait fonctionner.
Mais, après avoir fouillé partout, je ne trouve aucune piste de solution.

S'il vous plaît, quelqu'un peut-il m'orienter ou m'aider dans ce sens ?
Merci

Sub Campus()
Dim c As Range
Dim texte As String
Dim PPApp As Object
Dim PPTPrésentation As Object
Dim slideIndex As Integer

' Ouverture du PowerPoint s'il n'est pas déjà ouvert
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If PPApp Is Nothing Then
Set PPApp = CreateObject("PowerPoint.Application")
End If
PPApp.Visible = True

' Ouverure de la présentation PowerPoint existante ou creation d' une nouvelle présentation
On Error Resume Next
Set PPTPrésentation = PPApp.Presentations("ppt5E35.pptx")
On Error GoTo 0
If PPTPrésentation Is Nothing Then
Set PPTPrésentation = PPApp.Presentations.Open(ThisWorkbook.Path & "\ppt5E35.pptx")
End If

' Concaténation les données de la colonne 2 (C) de Tableau1 dans Excel
For Each c In ThisWorkbook.Sheets("Feuille1").Range("G2:G" & ThisWorkbook.Sheets("Feuille1").Cells(Rows.Count, 2).End(xlUp).Row)
If c.Offset(0, -1).Value >= 1 Then ' Vérifier si la note en colonne B est supérieure ou égale à 4
If c.Value <> "" Then
texte = texte & vbLf & "- " & c.Value ' Pour Ajouter un tiret devant chaque nouveau commentaire
End If
End If
Next
texte = Mid(texte, 2) ' Supprimer le premier retour à la ligne

' Insérer le texte dans le premier slide de la présentation
slideIndex = 2
With PPTPrésentation.Slides(slideIndex).Shapes("espaceCom").TextFrame.TextRange
.Text = texte
.ParagraphFormat.Alignment = 1 ' 1=alignement à gauche
End With

' Activer PowerPoint
AppActivate PPApp.Caption
End Sub

 

[crocrocro]

Pas de texte en double avec ton fichier.
Comme il existe des liaisons avec des fichiers externes (que je n'ai évidemment pas), j'ai rompu les liaisons.

 

[crocrocro]

Une remarque, mais qui n'a rien à voir avec le problème :
Dans la mise à jour depuis Excel, je t'ai fait ajouter ce code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Intersect(Target, Range("G2:G13")) Is Nothing) Then
        ExporterVersPPT
    End If
End Sub

qui lance la macro à chaque mise à jour d'un commentaire.
Mais ce n'est peut-être pas la bonne solution si vous mettez à jour pour un ensemble de commentaires et préférez piloter manuellement la mise à jour. Je m'explique, on pourrait
- sur le Change, faire juste un MsgBox indiquant qu'un commentaire a été ajouté ou modifié et qu'il faudra lancer la macro ExporterVersPPT pour mettre à jour PowerPoint avant de fermer le fichier Excel.
- ajouter un bouton "Mettra à jour PowerPoint" qui lancerait la macro.

 

[melltel]

Pas de texte en double avec ton fichier.
Comme il existe des liaisons avec des fichiers externes (que je n'ai évidemment pas), j'ai rompu les liaisons.
Regarde la pièce jointe 1198156

D'accord, merci .
Je vais essayer avec un autre Pc pour voir si le soucis c'est moi ou pas .
Merciiiii

 

[crocrocro]

Bonjour,
suite à ma remarque précédente, le code associé (à adapter) et le bouton BoutonPowerPoint sur la feuille

Private Sub BoutonPowerPoint_Click()
    ExporterVersPPT
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Intersect(Target, Range("G2:G13")) Is Nothing) Then
        'ExporterVersPPT
        MsgBox "un commentaire a été ajouté ou modifié." & vbCrLf _
        & "La présentation PowerPoint devra être mise à jour avant de fermer le fichier", vbInformation, "Avis sur la Formation"
    End If
End Sub

 

[crocrocro]

En pj, le fichier avec ma dernière proposition

Mais ce n'est peut-être pas la bonne solution si vous mettez à jour pour un ensemble de commentaires et préférez piloter manuellement la mise à jour. Je m'explique, on pourrait
- sur le Change, faire juste un MsgBox indiquant qu'un commentaire a été ajouté ou modifié et qu'il faudra lancer la macro ExporterVersPPT pour mettre à jour PowerPoint avant de fermer le fichier Excel.
- ajouter un bouton "Mettra à jour PowerPoint" qui lancerait la macro.

Un message est affiché à chaque mise à jour de commentaire.
Le bouton "Mettre à jour ..." effectue la mise à jour du PP.
J'ai modifié le code pour que la mise à jour se fasse sans qu'on Ouvre PowerPoint.
U message indique juste que la mise à jour a été faite.

 

[melltel]

En pj, le fichier avec ma dernière proposition

Un message est affiché à chaque mise à jour de commentaire.
Le bouton "Mettre à jour ..." effectue la mise à jour du PP.
J'ai modifié le code pour que la mise à jour se fasse sans qu'on Ouvre PowerPoint.
U message indique juste que la mise à jour a été faite.

Merci Crocrocro
s'il te plait saurais tu comment diminuer ou augmenter la taille des commentaires ?
je l'ai fait pour la moyenne sans soucis mais pour les commentaires j'ai toujours des erreurs

je met en commentaire ce qui me semblait juste et qui malheureusement ne marche pas

Merci

' Insérer le texte des commentaires dans le slide
For slideIndex = 2 To 7 ' Modifier si nécessaire pour spécifier le slide cible
'With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire").TextFrame.TextRange
' .Text = Texte
' .ParagraphFormat.Alignment = 1 ' 1 correspond à l'alignement à gauche
' End With
With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
.OLEFormat.Object.Text = Texte
'.Font.Size = 28 ' Ajuster la taille de la police
'.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft ' Alignement à gauche
'.TextFrame.TextRange.Font.Size = 5 ' Ajuster la taille de la police à 5

End With


' Insérer la moyenne dans le même slide
With PPTPrésentation.Slides(slideIndex).Shapes("RectangleNoteMoy").TextFrame.TextRange
.Text = "" & Format(moyenne, "0.00")
.Font.Bold = msoTrue
.Font.Color = RGB(0, 112, 192) ' Rouge
.ParagraphFormat.Alignment = 1 ' Alignement à gauche
.Font.Size = 28 ' Ajuster la taille de la police

End With

Next slideIndex

 

[crocrocro]

Bonjour Meltel,
voici le code pour une taille de police 8.
L'erreur vient de la propriété FontSize qui doit être sur .OLEFormat.Object et non directement sur .Shapes("Commentaire").
Pour le trouver (çà ne s'invente pas ), il faut (si vous ne savez pas) sur le fichier Excel :
- ouvrir l'éditeur Visual Basic (Alt + F11)
- mettre un point d'arrêt sur la ligne With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire") (F8 sur la ligne)
- mettre un espion (copier ce texte PPTPrésentation.Slides(slideIndex).Shapes("Commentaire") , Clic Droit ajouter une spion et coller dans expression;
- lancer la macro par le bouton Mettre à jour PowerPoint de la feuille
- l'exécution du code va s'arrêter sur la ligne du point d'arrêt
- dans la fenêtre espion,
clic sur + de la ligne PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
pour déplier l'arborescence (1er niveau) des propriétés et chercher où peut bien se trouver l'info qui vous intéresse (taille de police donc Font quelquechose),
déplier les différents niveaux ...
ici, l'info (FontSize) est sur PPTPrésentation.Slides(slideIndex).Shapes("Commentaire").OLEFormat.Object.

     With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
        .OLEFormat.Object.Text = Texte
        .OLEFormat.Object.FontSize = 8
    End With

Une remarque :
Dans le Titre de la discussion, il aurait été intéressant (c'est toujours possible de préciser qu'il s'agissait de PowerPoint

 

[crocrocro]

Le plus simple est cependant de le faire directement sur PowerPoint

 

[crocrocro]

Le code correspondant au post 20 où j'ai rectifié 2 ou 3 choses.

Sub ExporterVersPPT()

    Dim c As Range
    Dim Texte As String
    Dim PPApp As Object
    Dim PPTPrésentation As Object
    Dim slideIndex As Integer
    Dim moyenne As Double
    Dim PPDejaOuvert As Boolean

    ' Ouvrir PowerPoint s'il n'est pas déjà ouvert
    On Error Resume Next
    Set PPApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    If PPApp Is Nothing Then
        Set PPApp = CreateObject("PowerPoint.Application")
        PPDejaOuvert = False
    Else
        PPDejaOuvert = True
    End If
    
    ' ouvrir le fichier powerpoint SANS l'afficher
    Set PPTPrésentation = PPApp.Presentations.Open(ThisWorkbook.Path & "\ppt5E35.pptx", WithWindow:=msoFalse)
    
    ' Récupérer la moyenne depuis Excel
    moyenne = ThisWorkbook.Sheets("Feuille1").Range("F14").Value
    
    ' Concaténer les données de la colonne 2 (C) de Tableau1 dans Excel
    For Each c In ThisWorkbook.Sheets("Feuille1").Range("G2:G" & ThisWorkbook.Sheets("Feuille1").Cells(Rows.Count, 2).End(xlUp).Row)
        If c.Offset(0, -1).Value >= 1 Then ' Vérifier si la note en colonne B est supérieure ou égale à 4
            If c.Value <> "" Then
                Texte = Texte & vbLf & "- " & c.Value ' Ajouter un tiret devant chaque nouveau commentaire
            End If
        End If
    Next
    Texte = Mid(Texte, 2) ' Supprimer le premier retour à la ligne
    
    ' Insérer le texte des commentaires dans le slide
    slideIndex = 2 ' Modifier si nécessaire pour spécifier le slide cible
     With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
        .OLEFormat.Object.Text = Texte
        .OLEFormat.Object.FontSize = 8 'taille de police
    End With
    ' Insérer la moyenne dans le même slide

    With PPTPrésentation.Slides(slideIndex).Shapes("RectangleNoteMoy").TextFrame.TextRange
        .Text = "Moyenne: " & Format(moyenne, "0.00")
        .Font.Bold = msoTrue
        .Font.Color = RGB(255, 0, 0)  ' Rouge
        .ParagraphFormat.Alignment = 1 ' Alignement à gauche
    End With
  
    ' Enregistrer la mise à jour, fermer le fichier PPT et quitter PowerPoint
    PPTPrésentation.Save
    PPTPrésentation.Close
    If PPDejaOuvert = False Then
        ' on ne quitte PP que si on l'a ouvert par la macro
        PPApp.Quit
    End If

    MsgBox "La présentation PowerPoint a été mise à jour.", vbInformation, "Avis sur la Formation"
End Sub

 

[melltel]

Le plus simple est cependant de le faire directement sur PowerPoint
Regarde la pièce jointe 1198661

Merci Beaucoup

 

[melltel]

Bonjour Meltel,
voici le code pour une taille de police 8.
L'erreur vient de la propriété FontSize qui doit être sur .OLEFormat.Object et non directement sur .Shapes("Commentaire").
Pour le trouver (çà ne s'invente pas ), il faut (si vous ne savez pas) sur le fichier Excel :
- ouvrir l'éditeur Visual Basic (Alt + F11)
- mettre un point d'arrêt sur la ligne With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire") (F8 sur la ligne)
- mettre un espion (copier ce texte PPTPrésentation.Slides(slideIndex).Shapes("Commentaire") , Clic Droit ajouter une spion et coller dans expression;
- lancer la macro par le bouton Mettre à jour PowerPoint de la feuille
- l'exécution du code va s'arrêter sur la ligne du point d'arrêt
- dans la fenêtre espion,
clic sur + de la ligne PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
pour déplier l'arborescence (1er niveau) des propriétés et chercher où peut bien se trouver l'info qui vous intéresse (taille de police donc Font quelquechose),
déplier les différents niveaux ...
ici, l'info (FontSize) est sur PPTPrésentation.Slides(slideIndex).Shapes("Commentaire").OLEFormat.Object.

     With PPTPrésentation.Slides(slideIndex).Shapes("Commentaire")
        .OLEFormat.Object.Text = Texte
        .OLEFormat.Object.FontSize = 8
    End With

Une remarque :
Dans le Titre de la discussion, il aurait été intéressant (c'est toujours possible de préciser qu'il s'agissait de PowerPoint

merci,
c'est noté pour la remarque.