Mise à jour graphique Excel dans Email Outlook

**beta1204** · 26/09/2016, 14h43

Merci Oliv !
Vraiment sympa de me donner un coup de main !

Je regarde ça et je reviens vers toi pour te dire le résultat.

Merci

**beta1204** · 26/09/2016, 17h03

Après un ajustement, le code fonctionne correctement c'est super !

J'ai simplement un problème pour copier le second groupe de graphique.

J'utilise ce code :

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
    With objSel.Find
        objSel.Move wdStory, -1
        .ClearFormatting
        .Text = "ICILEGRAPH_2"
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Execute
        If .Found = True Then
            'copie du graph
            'With xlBook.Worksheets("Feuil2").ChartObjects("Graphique 1")
            '    .Chart.ChartArea.Copy
            With xlBook.Worksheets("Feuil2").Shapes.Range(Array("Group 2")).Select
                Selection.Copy
                'Selection.Copy
                '.CopyPicture
            'With xlBook.Worksheets("Feuil2").ChartObjects("Group 2")).Copy
                '.Shapes.Copy
            End With
            ' colle dans le mail
            objSel.Paste
            'objSel.PasteSpecial Link:=False, DataType:=14, Placement:=wdInLine
            '    DisplayAsIcon:=False
        End If
    End With

Lors de la copie, j'ai l'erreur 4605 indiquant qu'aucun texte n'est sélectionné.
Je continu de chercher pourquoi. C'est comme-ci que le groupe sélectionné n'est pas reconnu.

**Oliv-** · 26/09/2016, 17h43

pour les graph c'est ça

tu changes Feuil2 par le nom de ta feuille et Graphique 2 par celui du graphique

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
   With objSel.Find
        objSel.Move wdStory, -1
        .ClearFormatting
        .Text = "ICILEGRAPH_2"
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Execute
        If .Found = True Then
            '.Parent.Bold = True
            'copie des donnees
            'copie du graph
            With xlBook.Worksheets("Feuil2").ChartObjects("Graphique 2")
                .Chart.ChartArea.Copy
            End With
            ' colle dans le mail
            objSel.Paste
        End If
    End With

**beta1204** · 26/09/2016, 18h37

Veuillez m'excuser, je n’ai sûrement pas été assez clair en effet !
Pour un simple graphique, ça fonctionne parfaitement.

J'ai maintenant un groupe de graphiques avec images que je dois copier. J'ai groupé tous les graphiques et les images afin de garder la mise en forme principalement (et pour d'autres raisons) . (ça aurait été trop simple si j'avais que des graphiques à coller

)

La commande .Chart.ChartArea.Copy ne fonctionne donc pas pour un graphique.

C'est pour cela que je pensai pouvoir utiliser Selection.Copy afin de copier le groupe auparavant sélectionné.

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
With objSel.Find
        objSel.Move wdStory, -1
        .ClearFormatting
        .Text = "ICILEGRAPH_2"
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Execute
        If .Found = True Then
            'copie du graph
            With xlBook.Worksheets("Feuil2").Shapes.Range(Array("Group 2")).Select
                Selection.Copy
            End With
            ' colle dans le mail
            objSel.Paste
        End If
    End With

J'ai testé plusieurs commandes mais aucunes ne fonctionnent pour le moment.
Après ce problème je pense que j'aurai terminé (et grâce à vous !)

**Oliv-** · 27/09/2016, 09h38

Bonjour,
Quand on pilote une autre application ici OUTLOOK Pilote EXCEL (et WORD).
Il faut toujours faire précéder l'instruction par l'objet Excel, parce que sinon le programme pense que c'est une commande propre à OUTLOOK.

au lieu d'avoir selection.copy , il faut xlapp.selection.copy

il peut s'agir aussi d'autres objets dérivés de xlapp comme ici xlBook qui désigne le classeur, etc

Donc tu as plusieurs éléments des graphiques et des images groupées avec la fonction "GROUPER" c'est bien cela ? Est-ce qu'il y a aussi des cellules ?

**beta1204** · 27/09/2016, 10h01

Bonjour,

En effet c'est ça !

En ajoutant xlapp.selection.copy, ça colle bien le groupe. Par contre, ça ne remplace pas le texte ICILEGRAPH_2 mais colle le graphique par dessus. Cela implique que le texte qui en dessous du mot clé ICILEGRAPH_2 est égalment recouvert par le groupe de graphiques. ça ne doit pas être méchant, je vais rechercher la cause. Je essayer de trouver pourquoi le texte ICILEGRAPH_2 n'est pas remplacé à le groupe directement.

Oui, j'ai bien comme éléments des graphiques et des images groupées avec la fonction "GROUPER". Je n'ai pas de cellules.

Merci

**Oliv-** · 27/09/2016, 10h19

essaye avec cela,

en fait selon le type de données dans le presse papier le comportement du moteur WORD est différent, donc une fois le mot trouvé il faut le supprimer

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
 With objSel.Find
        objSel.Move wdStory, -1
        .ClearFormatting
        .Text = "ICILEGROUPE"
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Execute
        If .Found = True Then
            '.Parent.Bold = True
            'copie des donnees
            'copie du graph
            With xlBook.Worksheets("Feuil1").GroupObjects("Groupe 4")
                .Copy
            End With
            objSel.Delete Unit:=wdCharacter, Count:=1
            objSel.PasteSpecial Link:=False, DataType:=14, Placement:=wdInLine, _
                          DisplayAsIcon:=False
 
        End If
    End With

**beta1204** · 27/09/2016, 14h08

Parfait, ça fonctionne.
J'ai ensuite adapté le code afin de coller le groupe avec un habillage aligné sur le texte.

J'ai encore un terminer certains détails mais ça avance bien grâce à toi !

Merci

**beta1204** · 27/09/2016, 16h17

Le projet est en bonne voix d'être terminé.

L'idéal serait maintenant de pouvoir indiquer dans la macro directement le modèle utiliser pour créer le mail.

J'ai trouvé ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set otlApp = CreateObject("Outlook.Application")
    Set CurrentMessage = otlApp.CreateItemFromTemplate("C:\test\test.oft")

Serait-il possible de l'adapter avec notre code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Parti Outlook --> dans le mail ouvert
    Dim CurrentMessage As Object
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set CurrentMessage = Application.ActiveWindow.CurrentItem
    End If

Pour le moment les tests que j'ai fait de m'ouvre pas le modèle

**Oliv-** · 28/09/2016, 09h19

Salut,
oui c'est bien cela il faut remplacer le second par le premier, mais pour qu'il apparaisse il faut lui demander gentiment

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CurrentMessage.display

**beta1204** · 28/09/2016, 09h44

Bonjour,

Haa ça parait si simple quand on à la solution

.

Je n'ai plus qu'à trouver comment ne pas insérer dans le mail la signature défini par défaut dans Outlook et j'aurai terminé

.

Merci !

**Oliv-** · 28/09/2016, 11h10

eh oui

Pour ta signature

à la place du CurrentMessage.display

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
dim tmpHTMLBody
 
tmpHTMLBody=CurrentMessage.HTMLBODY
 
CurrentMessage.display
CurrentMessage.HTMLBODY=tmpHTMLBody

**beta1204** · 28/09/2016, 11h26

Et bien j'avais commencé rapidement à chercher une solution permettant de supprimer plusieurs lignes un peu comme nous faisons sur les marqueurs mais là c'est en effet beaucoup plus simple, merci !

J'ai donc utilisé le code comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    'Evite la signature par défaut
    Dim tmpHTMLBody
    tmpHTMLBody = CurrentMessage.HTMLBody
    CurrentMessage.Display
    CurrentMessage.HTMLBody = tmpHTMLBody

Donc si je comprends bien le code permet d'afficher la maquette normal avec la signature puis grâce à la variable tmpHTMLBody de supprimer la signature car un fait un reset de l'affichage pour y mettre uniquement le modèle de mail ?

PS : Pas besoin d'initialiser Dim tmpHTMLBody en tant qu'objet ?

Mise à jour graphique Excel dans Email Outlook

VBA Outlook

Discussions similaires

Partager

Partager