Discussion :

[libititi]

Bonjour,

Je commence depuis peu sous VBA, et j'ai un peu de mal...
Voilà ce que je veux faire.
J'ai une feuille qui s'appelle "base de données" sur laquelle j'ai toutes mes données. Sur les autres feuilles, j'ai des tableaux croisés dynamiques.
Ce que je souhaite faire, c'est créer une macro qui me permettrait en cliquant sur un bouton de copier la sélection active et de la coller (en gardant ma mise en page) dans le corps d'un mail (j'utilise Microsoft Outlook 2003), avec un message prédéfini et un destinataire spécifique (selon la modalité de la variable en PAGE).
Après avoir fait une petite recherche sur internet, je ne vois pas comment copier certaines cellules actives. En fait, la taille de mon tableau dépendra de la variable en PAGE. Je souhaite donc dans un premier temps sélectionner ma plage de donnée (mon tableau quoi) et ensuite cliquer sur le bouton qui m'ouvrira un message qui sera prêt à envoyer.

J'ai trouvé cela:

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
Option Explicit
 
'-----------------------------------------------------------------------
'
' Lit le contenu d'un fichier texte et retourne son
' contenu
'
'-----------------------------------------------------------------------
 
 Public Function ReadFile(sFileName) As String
 
Dim fso As Object, fFile As Object
Dim sTemp As String
 
   Set fso = CreateObject("Scripting.FileSystemObject")
 
   Set fFile = fso.OpenTextFile(sFileName, 1, False)
 
   sTemp = fFile.ReadAll
 
   fFile.Close
 
   Set fFile = Nothing
 
   ReadFile = sTemp
 
End Function
 
'-----------------------------------------------------------------------'
' Cette routine va créer une instance de Outlook (si
' pas encore démarré) et va ensuite ouvrir une
' fenêtre de type mail.   Le corps du message sera
' initialisé avec le contenu d'un fichier de type
' HTML.   Ce fichier aura été préalablement
' créé par la routine SendRangeByMail
'
' Nécessite l'ajout d'une référence vers "Microsoft
' Outlook Object Library"
'
'-----------------------------------------------------------------------
 
 Sub PrepareOutlookMail(ByVal sFileName As String)
 
Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem
 
   Set appOutlook = CreateObject("Outlook.Application")
 
   ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
   If Not (appOutlook Is Nothing) Then
 
      Set oMail = appOutlook.CreateItem(olMailItem)
 
      oMail.HTMLBody = ReadFile(sFileName)
 
      oMail.Display
 
      Set oMail = Nothing
      Set appOutlook = Nothing
 
   End If
 
End Sub
 
'-----------------------------------------------------------------------
'
' La routine SendRangeByMail va proposer à
' l'utilisateur de sélectionner une plage de cellules
' en Excel et va ensuite envoyer cette plage par
' mail, dans le corps du mail.
'
'-----------------------------------------------------------------------
 
 Sub SendRangeByMail()
 
Dim rngeSend As Range
 
   With Application
 
      On Error Resume Next
 
      ' Demande à l'utilisateur de sélectionner la
      ' plage de cellule
 
      Set rngeSend = .InputBox(Prompt:="Please select range you wish to send.", Type:=8, Default:=.Selection.Address)
 
      ' rngeSend Is Nothing lorsque l'utilisateur ne fait
      ' aucun choix
 
       If rngeSend Is Nothing Then Exit Sub
 
      On Error GoTo 0
 
      ' Exporte la plage vers un fichier de type HTML;
      ' ceci afin de respecter la mise en page de la
      ' plage
 
      .ActiveWorkbook.PublishObjects.Add(4, "C:\Temp\XLRange.htm", rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
 
      ' Appelle la routine qui va se charger de créer
      ' un mail
 
      Call PrepareOutlookMail("C:\Temp\XLRange.htm")
 
      ' Le fichier HTML n'est plus nécessaire
 
      Kill "C:\Temp\XLRange.htm"
 
   End With ' With Application
 
End Sub

Ce qui est pas mal, le problème c'est que je ne sais pas comment paramétrer le destinataire et le message prédéfini dans le corps du mail.
Avez vous une petite idée pour rajouter ces fonctionnalités ?

[libititi]

Bon, j'ai trouvé qqch mais je suis tjrs un peu bloqué:

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
Sub PrepareOutlookMail(ByVal sFileName As String)
 
    Dim appOutlook As Outlook.Application
    Dim oMail As Outlook.MailItem
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
 
   Set appOutlook = CreateObject("Outlook.Application")
 
   ' Si Outlook n'était pas ouvert, l'instruction
    ' ci-dessus aura eu pour conséquence de
    ' démarrer Outlook.
    'Ce type de démarrage par automation fait
    'apparaître une fenêtre de sécurité qui demande
    'à l'utilisateur de permettre au programme de
    'continuer.
    '
    'Le message est "A program is trying to send an
    'email.   Do you want to allow..."
    '
    'Dans le cas où l'utilisateur aurait cliqué sur No,
    'l'objet appOutlook est égal à Nothing.  Il est
    'donc impossible de continuer.
 
   If Not (appOutlook Is Nothing) Then
 
      Set oMail = appOutlook.CreateItem(olMailItem)
 
      SigString = Environ("appdata") & _
     "\Microsoft\Signatures\Girier.txt"
 
 
     If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
     Else
        Signature = ""
     End If
 
    strbody = "<H3><B>Bonjour,</B></H3>" & _
              "Veuillez trouver ci-dessous un cumul des commandes passées par S&P sur l'année 2012 sur le projet.<br>" & _
              "Ceci vient en complément du reporting projet que nous vous envoyons toutes les 2 semaines.<br>"
 
    With oMail
 
      .Subject = "S et P - Suivi des dépenses xxxxxxxxxxxxxx"
      .To = "someone@example.com"
      .HTMLBody = ReadFile(sFileName) & strbody & Signature
      .Display
    End With
      Set oMail = Nothing
      Set appOutlook = Nothing
 
   End If
 
 
 
 
End Sub

Sachant que la fonction ReadFile me permet de récupérer ma sélection sur ma feuille Excel.

En fait, le problème se situe au niveau de ma commande

Code :

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

.HTMLBody = strbody & ReadFile(sFileName)  & Signature

Quand mon mail s'ouvre, je n'ai que la sélection de mes données (ReadFile(sFileName)), et pas la partie strbody, ni ma signature.

Comment faire pour corriger cela ?