Discussion :

[bigokou]

Bonjour je me presente big bigokou pour les intimes voila je démarre sur vba et j essaie de créer des codes en auto didact c est pas facile mais j arrive a me debrouiller la je suis bloqué car j aimerais avoir de l aide pour envoye des fichier excel trier par correspondant budgétaire et l'élement déclencheur serait à relancer qui peut m aider????

[Daniel.C]

Bonjour,

Peux-tu donner un exemple de ce que tu veux faire ?

[bigokou]

bonjour merci de me repondre je voudrais par exemple selectionne pour pascal roehr toutes les factures qui sont à relancer et lui envoye un mail avec un message, ainsi que pour tous les autres correspondant ...

[Daniel.C]

1. Quelle est ta version d'Excel ?
2. Quel est ton logiciel de messagerie ?

[bigokou]

excel 2007 et outlook 2007

[Daniel.C]

Regarde le code suivant. Pour chaque message, les factures sont dans un classeur en pièce jointe. C'est plus compliqué de les incorporer dans le texte du message.

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
Sub EnvoiMail()
    Dim C As Range, Plage As Range, Factures As Range, Plage2 As Range
    Dim OlApp As Object, M As Object, Wbk As Workbook
    Set OlApp = CreateObject("Outlook.application")
    With Sheets("DOMAINE")
        Set Plage = .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Justif")
        Set Factures = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 11)
        For Each C In Plage
            .AutoFilterMode = False
            Factures.AutoFilter 5, C.Value
            Factures.AutoFilter 10, "à relancer"
            Set Plage2 = Factures.Offset(1).Resize(Factures.Rows.Count - 1, 1)
            If Application.Subtotal(103, Plage2) > 0 Then
                Set Plage2 = Factures.SpecialCells(xlCellTypeVisible)
                Set M = OlApp.CreateItem(olMailItem)
                Set Wbk = Workbooks.Add(1)
                Plage2.Copy Wbk.Sheets(1).[A1]
                On Error Resume Next
                Kill ThisWorkbook.Path & "\" & "temp.xls"
                Wbk.SaveAs ThisWorkbook.Path & "\" & "temp", FileFormat:=xlExcel8
                Wbk.Close False
                On Error GoTo 0
                With M
                    .Subject = "Objet"
                    .Body = "Message"
                    .Recipients.Add C.Offset(, 2).Value
                    .attachments.Add ThisWorkbook.Path & "\" & "temp.xls"
                    '.Display
                    .Send
                End With
                Kill ThisWorkbook.Path & "\" & "temp.xls"
            End If
        Next C
    End With
End Sub