Re : double click
Merci encore mais il que la commande soit sur la feuille afin de pouvoir réactivé le double click après l'envoi je te montre le code :
Private Sub CommandButton2_Click()
Sheets("Acceuil").ScrollArea = "a1:a1"
CommandButton3.Enabled = False
CommandButton1.Enabled = False
CommandButton2.Enabled = False
' code adapté d'une source d'excel download
'fonctionne en version 2000-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille vers un classeur temporaire
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine la version Excel le chemin l'extension le format
With Destwb
If Val(Application.Version) < 12 Then
'vous utilisez Excel 2000-2003 : c'est OK
FileExtStr = ".xls": FileFormatNum = -4143
Else
'vous utilisez Excel 2007 : message ??
'Sortie si la réponse est non dans la boite de dialogue que vous voyez lorsque vous copiez une feuille avec les macros désactivées 'see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Vouz avez répondu non"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
'Enregistre le nouveau classeur vers dossier temporaire,l'expédie,Puis le détruit
TempFilePath = Environ$("temp") & "\"
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
' expédie le mail à l'adresse:
.To = "********.*****@*****.fr"
.CC = ""
.BCC = ""
' remplit le champs objet du mail
.Subject = "**** du : " & Date - 1 & " au : " & Date
'place la copie en piece jointe( bas du mail)
.htmlBody = "<br>"
.htmlBody = " *********IS : " & Range("d22").Text
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
'Détruit le fichier envoyé
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
CommandButton3.Enabled = True
CommandButton1.Enabled = True
CommandButton2.Enabled = True
Sheets("Acceuil").ScrollArea = " "
End Sub
Si tu peux faire quelque chose!
