Ajout de Signature en HTML dans un code existant (BY PAPOU)
H
Bonjour a tous,
Avant de commencer, je profite de cet occasion pour remercier notre ami "PAPOU" qui m'as vraiment sauvé la vie.
Ma demande serait plutot esthétique, je veux rajouter ma signature en HTML a ce code développé par PAPOU.
'Macro Faite par Papou
Option Explicit
Public x$, cc, xx$
Sub envoyer()
Dim i&, a&, aa, bb, y&, n&, fin&
Feuil1.Cells.Copy Feuil3.Cells
Feuil3.Range("A3:R" & Feuil3.Range("A" & Rows.Count).End(3).Row).ClearContents
With Feuil2
aa = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Feuil1
bb = .Range("A3:R" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(aa)
ReDim cc(1 To UBound(bb), 1 To UBound(bb, 2)): y = 1
For a = 1 To UBound(bb)
If aa(i, 1) = bb(a, 1) Then
For n = 1 To UBound(bb, 2)
cc(y, n) = bb(a, n)
Next n
y = y + 1
End If
Next a
If y = 1 Then
GoTo 1
Else
Feuil3.Range("A3").Resize(UBound(cc), UBound(cc, 2)) = cc
Feuil3.Range("A" & Feuil3.Range("A" & Rows.Count).End(3).Row + 1) = Feuil2.Range("F2")
Feuil3.Select
x = aa(i, 2)
Call EnvoiPlage
With Feuil3
fin = .Range("A" & Rows.Count).End(3).Row
If fin < 2 Then fin = 2
.Range("A3:R" & fin).ClearContents
End With
End If
1 Next i
Feuil3.Cells.Clear
Feuil2.Select
End Sub
Sub EnvoiPlage()
ActiveSheet.Range("A1:R" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row).Select
With Feuil2
xx = .Range("E2")
End With
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "Bonjour"
.Item.To = x
.Item.cc = xx
.Item.Subject = "#Subject#"
.Item.Send
End With
End Subbonsoir Hich14
as tu vu le post en bas de celui ci donné il y 15 jours
H
Merci pour la notification ,
Je ne l'avais pas vu !*
Cela confirme que le sujet est assez compliqué , pour ne pas dire impossible.
ESPERONS