IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Graphiques excel vers powerpoint en liaison


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Dataminer
    Inscrit en
    Juillet 2008
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Dataminer

    Informations forums :
    Inscription : Juillet 2008
    Messages : 54
    Par défaut Graphiques excel vers powerpoint en liaison
    Bonjour,

    J'ai un fichier excel avec des feuilles graphiques. Je voudrais coller EN LIAISON chaque feuille graphique dans une nouvelle diapositive powerpoint, en gardant la même mise en forme graphique (même format, même couleurs, etc...).
    Le collage en liaison permettra par la suite de mettre à jour via powerpoint directement sans relancer la macro.
    Je débute dans VBA, j'ai seulement réussi à copier mon graphique et le coller sur une diapo, mais sans garder la mise en forme (les couleurs changent).

    Pouvez-vous m'aider svp ?

    Ci-joint mon fichier excel :
    Fichiers attachés Fichiers attachés

  2. #2
    Membre éprouvé Avatar de DidierLoche
    Profil pro
    Inscrit en
    Octobre 2008
    Messages
    84
    Détails du profil
    Informations personnelles :
    Âge : 60
    Localisation : France, Haute Garonne (Midi Pyrénées)

    Informations forums :
    Inscription : Octobre 2008
    Messages : 84
    Par défaut
    Bonsoir,

    Très intéressant ton code, ça m'ouvre de nouvelles perspectives.
    Je me suis permis d'ajouter quelques éléments :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    Sub ppt()
     
    Dim ppt As PowerPoint.Application
    Dim pres As PowerPoint.Presentation
    Dim myslide As Slide
     
     
    Set ppt = CreateObject("PowerPoint.Application")
    ppt.Visible = True
     
    Set ppt = New PowerPoint.Application
    Set pres = ppt.Presentations.Open(Filename:="D:\Documents and Settings\Didier\Mes documents\VBA\Présentation.ppt")
     
     
    Charts("Graph1").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
     
    N_shapes = ppt.Presentations(ppt.Presentations.Count).Slides(1).Shapes.Count
    ppt.Presentations(ppt.Presentations.Count).Slides(1).Shapes.PasteSpecial ppPasteMetafilePicture, link:=msoTrue
    With ppt.Presentations(ppt.Presentations.Count).Slides(1).Shapes(N_shapes + 1)
        .Left = 50
        .Top = 50
        .Width = 600
        .Height = 400
    End With
    End Sub
    link:=msoTrue permet de lier ton image ppt à ton graphe Excel. Tu peux ensuite redimensionner, déplacer les images comme tu le souhaite. Je n'ai pas fait le tour des possibilités mais je pense qu'on peut aller loin.
    J'ai ajouté aussi une variable N_shapes pour être sûr de redimensionner celle qu'on vient d'insérer.

    Didier

  3. #3
    Membre confirmé
    Homme Profil pro
    Dataminer
    Inscrit en
    Juillet 2008
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Dataminer

    Informations forums :
    Inscription : Juillet 2008
    Messages : 54
    Par défaut
    J'ai réussi à faire ce que je voulais faire :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    Sub ppt()
     
    Call Initialisation
    Call initialisation_couleurs
     
    Dim ppt As PowerPoint.Application
    Dim pres As PowerPoint.Presentation
    Dim Diapo As PowerPoint.Slide
    Dim NbShpe, cpt, cpt1, cpt2, cpt_row, cpt_col, fin_cpt As Integer
    Dim modelePath, finalPath As Variant
    Dim temp As String
    Dim ws As Worksheet
    Dim c As Chart
     
     
    modelePath = Application.GetOpenFilename()
     
    Set ppt = CreateObject("PowerPoint.Application") 'creation de l'objet powerpoint
    ppt.Visible = True 'active powerpoint
    Set ppt = New PowerPoint.Application
     
     
     
    If modelePath <> False Then
     
        'ouverture du modèle de présentation
        Set pres = ppt.Presentations.Open(Filename:=modelePath)
     
     
        ws_croises.Previous.Select
        fin_cpt = Right(ActiveSheet.Name, 2)
     
     
    'INITIALISATION DES COMPTEURS
    '--------------------------------------------------------------------------------------------------------
        cpt = 1
        cpt1 = 2
        cpt2 = 4
    '--------------------------------------------------------------------------------------------------------
     
        ws_taux.Select
     
        While cpt <> fin_cpt + 1
     
            Set Diapo = pres.Slides(cpt2)
            pres.Slides(pres.Slides.Count).Duplicate
     
     
    'AFFICHAGE DES TITRES
    '--------------------------------------------------------------------------------------------------------
            temp = Mid(ws_taux.Range("C" & cpt1), InStr(ws_taux.Range("C" & cpt1), " ") + 1, Len(ws_taux.Range("C" & cpt1)))
            Diapo.Shapes(1).TextFrame.TextRange.Text = temp
    '--------------------------------------------------------------------------------------------------------
     
     
    'AFFICHAGE DES TAUX DE REPONSES
    '--------------------------------------------------------------------------------------------------------
            If ws_taux.Range("D" & cpt1).Value <> "NS" Then
                Diapo.Shapes(3).TextFrame.TextRange.Text = Left(ws_taux.Range("D" & cpt1).Value * 100, 4) & "%"
            Else
                Diapo.Shapes(3).TextFrame.TextRange.Text = ws_taux.Range("D" & cpt1).Value
            End If
    '--------------------------------------------------------------------------------------------------------
     
     
    'AFFICHAGE DES GRAPHIQUES
    '--------------------------------------------------------------------------------------------------------
            For Each c In wb.Charts
                If Left(c.Name, 7) = "Graph" & cpt Then
     
                    c.ChartArea.Copy
                    Diapo.Shapes.PasteSpecial Link:=True
     
                    ' compte le nombre de shapes dans la diapositive
                    ' le dernier objet inséré correspond à l'index le plus élevé
                    NbShpe = Diapo.Shapes.Count
     
                    'renomme et met en forme l'objet collé
                    With Diapo.Shapes(NbShpe)
                        '.Name = "monGraph" 'personnalise le nom
                        .Left = 125 'définit la position horizontale dans le slide
                        .Top = 150 'définit la position verticale dans le slide
                        .Height = 350 'hauteur
                        .Width = 450 'largeur
                    End With
                End If
            Next c
    '--------------------------------------------------------------------------------------------------------
     
            'Application.Windows("Outil premiers résultats V20081020_bis.xls").Activate
     
     
    'AFFICHAGE DES TABLEAUX (SI EXISTANTS)
    '--------------------------------------------------------------------------------------------------------
            For Each ws In wb.Worksheets
     
                If Left(ws.Name, 5) = "Tab" & cpt Then
     
                    cpt_row = 1
                    cpt_col = 1
     
                    While ws.Cells(cpt_row, 1) <> ""
                        cpt_row = cpt_row + 1
                    Wend
     
                    While ws.Cells(1, cpt_col) <> ""
                        cpt_col = cpt_col + 1
                    Wend
     
                    Set tabfin = ws.Range(ws.Cells(1, 1), ws.Cells(cpt_row - 1, cpt_col - 1))
                    tabfin.Copy
                    Diapo.Shapes.PasteSpecial Link:=True
     
                    NbShpe = Diapo.Shapes.Count
     
                    'renomme et met en forme l'objet collé
                    With Diapo.Shapes(NbShpe)
                        '.Name = "monGraph" 'personnalise le nom
                        .Left = 125 'définit la position horizontale dans le slide
                        .Top = 450 'définit la position verticale dans le slide
                        .Height = 250 'hauteur
                        .Width = 350 'largeur
                    End With
     
                End If
     
            Next ws
    '--------------------------------------------------------------------------------------------------------
     
     
    'INCREMENTATION DES COMPTEURS
    '--------------------------------------------------------------------------------------------------------
            cpt = cpt + 1
            cpt1 = cpt1 + 1
            cpt2 = cpt2 + 1
    '--------------------------------------------------------------------------------------------------------
     
     
     
        Wend
     
        'finalPath = Application.GetSaveAsFilename
     
        'If finalPath <> False Then
        '    pres.SaveAs (finalPath)
        'End If
     
    End If
     
     
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Envoie données/Graphiques excel vers powerpoint
    Par meumeu73.1 dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 14/01/2008, 15h08
  2. Copiez coller d'Excel vers Powerpoint au milieu d'une zone de texte
    Par tenaka69 dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 13/08/2007, 19h03
  3. Erreur lors de transfert excel vers Powerpoint
    Par hallucine dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 07/09/2006, 14h27
  4. [VBA-E]Excel vers powerpoint : copier/coller spécial
    Par illight dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 06/09/2006, 12h41
  5. recuperer 1 graphique excel vers VB
    Par tomgrc dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 25/02/2005, 17h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo