J'utilise un fichier de Pierre Wautier avec la macro ci-dessous et je
voudrais l'ameliorer mais je n y arrive pas.
1-Je voudrais que seul les lignes avec des donnees en colonne A soient
selectionnees (dans la plage A1:AI48)
2-Je voudrais que ce nouveau classeur soit envoye par mail à une
adresse defini dans ma feuille "Parametre" en cellule "C15"
3-J aimerais que le classeur en piece jointe porte le nom de la feuille
exporte et non pas "ClasseurX.xls"
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Frédéric Sigonneau
Bonjour,
Peut-être cette proposition de code pourra-t-elle t'aider à avancer dans ton projet (il faut tout recopier dans un module standard du classeur contenant les données à exporter, et lancer la procédure transfert_réseau_DSIP après avoir modifié les paramètres passés à la procédure EnvoiCourriel par tes propres adresses et nom de serveur smtp valides) :
'============================ Private Declare Function InternetAutodial Lib "Wininet" _ (ByVal dwFlags As Long, ByVal hwndParent As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" _ (ByVal dwReserved As Long) As Long
Public Declare Function InternetGetConnectedState Lib "wininet.dll" _ (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Sub transfert_réseau_DSIP() Dim Wbk, TmpWbk, Chemin$
Set Wbk = ThisWorkbook ActiveSheet.Unprotect Application.GoTo Reference:="R1C1" 'plage des données (Q1) Range(ActiveCell.CurrentRegion.Address).Copy Set TmpWbk = Workbooks.Add Range("A1").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:úlse Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:úlse Columns("A:A").ColumnWidth = 4.44 Columns("B:B").EntireColumn.AutoFit Application.CutCopyMode = False Columns("C:" & Split(ActiveCell.CurrentRegion.Address, "$")(3)).ColumnWidth = 2.3 With ActiveWindow .DisplayGridlines = False .DisplayZeros = False End With With ActiveSheet.PageSetup .CenterHorizontally = True .CenterVertically = True .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = 1 End With '(Q3) TmpWbk.SaveAs ActiveSheet.Name Chemin = TmpWbk.FullName TmpWbk.Close False '(Q2) EnvoiCourriel Wbk.Sheets("Parametre").Range("C5").Value, _ "", _ "smtp.wanamou.fr", "test", "", Chemin
ActiveSheet.Protect DrawingObjects:úlse, Contents:=True, Scenarios:úlse Kill Chemin End Sub
Sub EnvoiCourriel(Destinataire$, Expéditeur$, ServeurSMTP$, _ Sujet$, TexteMessage$, _ Optional PieceJointe = "") Dim EtatConnexion As Boolean, Etat As Long
'Se connecter à Internet si ce n'est fait EtatConnexion = (InternetGetConnectedState(Etat, 0&) <> 0) If Not EtatConnexion Then InternetAutodial 1, 0 While Not (InternetGetConnectedState(Etat, 0&) <> 0) Wend End If
'Construction et envoi With CreateObject("CDO.Message") .From = Expéditeur .To = Destinataire .Subject = Sujet .TextBody = TexteMessage If PieceJointe <> "" Then .AddAttachment PieceJointe With .Configuration.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ServeurSMTP .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With .Send End With
'Remise en l'état initial If Not EtatConnexion Then InternetAutodialHangup 0&
End Sub 'fs '============================ FS -- Frédéric Sigonneau [MVP Excel - né un sans-culottide] Gestions de temps, VBA pour Excel : http://perso.wanadoo.fr/frederic.sigonneau Si votre question sur Excel est urgente, évitez ma bal !
Jacquouille Le Gaulois a écrit:
Bonjour,
J'utilise un fichier de Pierre Wautier avec la macro ci-dessous et je voudrais l'ameliorer mais je n y arrive pas. 1-Je voudrais que seul les lignes avec des donnees en colonne A soient selectionnees (dans la plage A1:AI48)
2-Je voudrais que ce nouveau classeur soit envoye par mail à une adresse defini dans ma feuille "Parametre" en cellule "C15" 3-J aimerais que le classeur en piece jointe porte le nom de la feuille exporte et non pas "ClasseurX.xls"
Peut-être cette proposition de code pourra-t-elle t'aider à avancer dans ton
projet (il faut tout recopier dans un module standard du classeur contenant les
données à exporter, et lancer la procédure transfert_réseau_DSIP après avoir
modifié les paramètres passés à la procédure EnvoiCourriel par tes propres
adresses et nom de serveur smtp valides) :
'============================ Private Declare Function InternetAutodial Lib "Wininet" _
(ByVal dwFlags As Long, ByVal hwndParent As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" _
(ByVal dwReserved As Long) As Long
Public Declare Function InternetGetConnectedState Lib "wininet.dll" _
(lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Sub transfert_réseau_DSIP()
Dim Wbk, TmpWbk, Chemin$
Set Wbk = ThisWorkbook
ActiveSheet.Unprotect
Application.GoTo Reference:="R1C1"
'plage des données (Q1)
Range(ActiveCell.CurrentRegion.Address).Copy
Set TmpWbk = Workbooks.Add
Range("A1").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Columns("A:A").ColumnWidth = 4.44
Columns("B:B").EntireColumn.AutoFit
Application.CutCopyMode = False
Columns("C:" & Split(ActiveCell.CurrentRegion.Address, "$")(3)).ColumnWidth = 2.3
With ActiveWindow
.DisplayGridlines = False
.DisplayZeros = False
End With
With ActiveSheet.PageSetup
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'(Q3)
TmpWbk.SaveAs ActiveSheet.Name
Chemin = TmpWbk.FullName
TmpWbk.Close False
'(Q2)
EnvoiCourriel Wbk.Sheets("Parametre").Range("C5").Value, _
"fs.fs@wanamou.fr", _
"smtp.wanamou.fr", "test", "", Chemin
ActiveSheet.Protect DrawingObjects:úlse, Contents:=True, Scenarios:úlse
Kill Chemin
End Sub
Sub EnvoiCourriel(Destinataire$, Expéditeur$, ServeurSMTP$, _
Sujet$, TexteMessage$, _
Optional PieceJointe = "")
Dim EtatConnexion As Boolean, Etat As Long
'Se connecter à Internet si ce n'est fait
EtatConnexion = (InternetGetConnectedState(Etat, 0&) <> 0)
If Not EtatConnexion Then
InternetAutodial 1, 0
While Not (InternetGetConnectedState(Etat, 0&) <> 0)
Wend
End If
'Construction et envoi
With CreateObject("CDO.Message")
.From = Expéditeur
.To = Destinataire
.Subject = Sujet
.TextBody = TexteMessage
If PieceJointe <> "" Then .AddAttachment PieceJointe
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
ServeurSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
.Send
End With
'Remise en l'état initial
If Not EtatConnexion Then InternetAutodialHangup 0&
End Sub 'fs
'============================
FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !
Jacquouille Le Gaulois a écrit:
Bonjour,
J'utilise un fichier de Pierre Wautier avec la macro ci-dessous et je
voudrais l'ameliorer mais je n y arrive pas.
1-Je voudrais que seul les lignes avec des donnees en colonne A soient
selectionnees (dans la plage A1:AI48)
2-Je voudrais que ce nouveau classeur soit envoye par mail à une adresse
defini dans ma feuille "Parametre" en cellule "C15"
3-J aimerais que le classeur en piece jointe porte le nom de la feuille
exporte et non pas "ClasseurX.xls"
Peut-être cette proposition de code pourra-t-elle t'aider à avancer dans ton projet (il faut tout recopier dans un module standard du classeur contenant les données à exporter, et lancer la procédure transfert_réseau_DSIP après avoir modifié les paramètres passés à la procédure EnvoiCourriel par tes propres adresses et nom de serveur smtp valides) :
'============================ Private Declare Function InternetAutodial Lib "Wininet" _ (ByVal dwFlags As Long, ByVal hwndParent As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" _ (ByVal dwReserved As Long) As Long
Public Declare Function InternetGetConnectedState Lib "wininet.dll" _ (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Sub transfert_réseau_DSIP() Dim Wbk, TmpWbk, Chemin$
Set Wbk = ThisWorkbook ActiveSheet.Unprotect Application.GoTo Reference:="R1C1" 'plage des données (Q1) Range(ActiveCell.CurrentRegion.Address).Copy Set TmpWbk = Workbooks.Add Range("A1").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:úlse Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:úlse Columns("A:A").ColumnWidth = 4.44 Columns("B:B").EntireColumn.AutoFit Application.CutCopyMode = False Columns("C:" & Split(ActiveCell.CurrentRegion.Address, "$")(3)).ColumnWidth = 2.3 With ActiveWindow .DisplayGridlines = False .DisplayZeros = False End With With ActiveSheet.PageSetup .CenterHorizontally = True .CenterVertically = True .Orientation = xlLandscape .FitToPagesWide = 1 .FitToPagesTall = 1 End With '(Q3) TmpWbk.SaveAs ActiveSheet.Name Chemin = TmpWbk.FullName TmpWbk.Close False '(Q2) EnvoiCourriel Wbk.Sheets("Parametre").Range("C5").Value, _ "", _ "smtp.wanamou.fr", "test", "", Chemin
ActiveSheet.Protect DrawingObjects:úlse, Contents:=True, Scenarios:úlse Kill Chemin End Sub
Sub EnvoiCourriel(Destinataire$, Expéditeur$, ServeurSMTP$, _ Sujet$, TexteMessage$, _ Optional PieceJointe = "") Dim EtatConnexion As Boolean, Etat As Long
'Se connecter à Internet si ce n'est fait EtatConnexion = (InternetGetConnectedState(Etat, 0&) <> 0) If Not EtatConnexion Then InternetAutodial 1, 0 While Not (InternetGetConnectedState(Etat, 0&) <> 0) Wend End If
'Construction et envoi With CreateObject("CDO.Message") .From = Expéditeur .To = Destinataire .Subject = Sujet .TextBody = TexteMessage If PieceJointe <> "" Then .AddAttachment PieceJointe With .Configuration.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ServeurSMTP .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With .Send End With
'Remise en l'état initial If Not EtatConnexion Then InternetAutodialHangup 0&
End Sub 'fs '============================ FS -- Frédéric Sigonneau [MVP Excel - né un sans-culottide] Gestions de temps, VBA pour Excel : http://perso.wanadoo.fr/frederic.sigonneau Si votre question sur Excel est urgente, évitez ma bal !
Jacquouille Le Gaulois a écrit:
Bonjour,
J'utilise un fichier de Pierre Wautier avec la macro ci-dessous et je voudrais l'ameliorer mais je n y arrive pas. 1-Je voudrais que seul les lignes avec des donnees en colonne A soient selectionnees (dans la plage A1:AI48)
2-Je voudrais que ce nouveau classeur soit envoye par mail à une adresse defini dans ma feuille "Parametre" en cellule "C15" 3-J aimerais que le classeur en piece jointe porte le nom de la feuille exporte et non pas "ClasseurX.xls"
