Problème envoi par mail des cellules filtrées VBA

Version imprimable

24/03/2011, 11h41
Miguel973

Problème envoi par mail des cellules filtrées VBA

Bonjour à tous,

je m'adresse à vous car j'ai un petit souci.
En effet, j'ai une feuille excel contenant un tableau avec des informations que je souhaiterai filtrer et envoyer par la suite par mail.
Le soucis est que lorsque je lance mon script, celui-ci m'envoit toutes les données par mail et pas celles filtrées au préalable :s

Je souhaiterai donc si possible qu'une âme charitable me vienne t'en aide, je lui en serais vraiment reconnaissant.

Vous trouverez sur ce site mon fichier excel avec les macros : http://www.cijoint.fr/cjlink.php?fil...ijelhrbid.xlsm

Par rapport au fichier excel, petite précision :
je souhaiterais filtrer la colonne I (Référent(s)), et une fois celle-ci filtrée je voudrais que les infos présentes alors dans ma feuille excel filtrée me soit envoyé par mail.
Mon système d'envoi de mail fonctionne, mon souci est que lorsque je fais mon filtre et que je m'envois le mail, je n'ai pas seulement les données filtrées mais l'ensemble de ma feuille excel :(

Merci par avance,

Miguel

bonjour,

voici comment je procèderai :

Code:

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
 
    'constantes à modifier si le tableau évolue
    'Nombre de Colonnes
    Const DCOL = 14
    'Colonne du Demandeur
    Const DCOLD = 9
 
Sub SendMail_Outlook(nomdest As String)
   'Définition des variables
   Dim ol As New Outlook.Application
   Dim olmail As MailItem
   Dim CurrFile As String
    Dim Selection As Range
    Dim lastcell As String
    Dim vtab As String
    Dim vrow As Integer
'Instanciation de l'objet Outlook
   Set ol = New Outlook.Application
   Set olmail = ol.CreateItem(olMailItem)
   'Recherche du nombre de lignes dans le tableau pour calcul du Range
    vrow = 1
    While Sheets("Basedonnées").Cells(vrow, 1) <> ""
        vrow = vrow + 1
    Wend
    'Selection du Tableau
    With Sheets("Basedonnées")
        .Range(Cells(1, 1), Cells(vrow, DCOL)).AutoFilter Field:=DCOLD, Criteria1:=nomdest
    End With
    'Passage du Range à l'objet pour transformation en html
    'Selection = Sheets("Basedonnées").Range(Cells(1, 1), Cells(vrow, DCOL))
    'Paramêtrage de l'objet Mail en vue d'envoie
   With olmail
      .To = nomdest
      '.To = "adresse mail"
      .Subject = "Tâche à réaliser"
      .BodyFormat = olFormatHTML
        .HTMLBody = PH(Sheets("Basedonnées").Range(Cells(1, 1), Cells(vrow, DCOL)).SpecialCells(xlCellTypeVisible))
      .Send
   End With
End Sub
 
Function PH(LaPlage As Range) As String
' transforme une plage en tableau HTML
Dim l As Long, C As Range
PH = "<html><table width='100%'>" 'balises de début du code HTML et de début de table
For Each C In LaPlage.Cells ' pour chaque ligne de la plage
    If C.Column = 1 Then PH = PH & "<tr>" ' balise de début de ligne
    ' balise début de colonne + contenu de la cellule + balise fin de colonne
    PH = PH & "<td>" & C.Value & "</td>"
    If C.Column = DCOL Then PH = PH & "</tr>" ' balise fin de ligne
Next C
PH = PH & "</table></html>" ' balises de fin de table et de fin de code HTML
'MsgBox PH
End Function

Bonjour,

Une autre possibilité, ajouter un nouveau classeur et y coller les valeurs filtrées puis envoi :

Code:

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
 
Sub Filtre()
 
    Dim Cl_Recup As Workbook
    Dim Cl_Filtre As Workbook
    Dim Fe_Recup As Worksheet
    Dim Fe_Filtre As Worksheet
    Dim Plg As Range
 
    Set Cl_Filtre = ActiveWorkbook
    Set Fe_Filtre = Cl_Filtre.Worksheets("Feuil1")
 
    'ajoute un nouveau classeur pour recevoir les valeurs filtrées
    Set Cl_Recup = Workbooks.Add
 
    'défini la feuille "Feuil1" comme cible pour
    'la récupération des valeurs filtrées
    Set Fe_Recup = Cl_Recup.Worksheets("Feuil1")
 
    'défini la plage à filtrer (toutes les cellules utilisées)
    Set Plg = Plage(Fe_Filtre)
 
    With Plg
 
        'exécute le filtrage (9 = I, adapter la valeur cherchée)
        .AutoFilter 9, "Valeur cherchée"
 
        'copie les valeurs filtrées dans le nouveau classeur
        Fe_Filtre.AutoFilter.Range.EntireRow.Copy Fe_Recup.[A1]
 
        'supprime le filtrage
        .AutoFilter
 
    End With
 
    'envoi du classeur, "Moi même" <- adapter le nom
    Cl_Recup.SendMail "Moi même", "Mon classeur"
 
End Sub
 
Function Plage(Fe As Worksheet) As Range
 
    With Fe
 
        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))
 
    End With
 
End Function

Hervé.

24/03/2011, 14h31
Miguel973

Merci

ça marche c'est génial !!! Merci Mayekeul

Je te remercie de ta réponse, Hervé, je la mets de côté. Je pense qu'elle me sera nécessaire par la suite.

Bien cordialement,

Miguel
25/03/2011, 10h31
Miguel973

C'est encore moi

Bonjour à vous,

j'aurais une petite question.
Je voudrais savoir s'il serait possible d'effectuer un double filtrage dans mon fichier.
Je m'explique, je souhaiterai filtrer ma colonne référent et également ma colonne statut qui indique si la tâche est en cours, achevée ou non débutée.
Je voudrais donc que seules les données ayant comme référent "X" et comme statut différent de "Achevée" me soit envoyées par mail.

Quelqu'un aurait il une solution à me proposer?

Je vous en remercie par avance,

Bien cordialement,

Miguel
25/03/2011, 11h12
Miguel973

problème résolu

Problème résolu merci :)