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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
|
fichier BAT de lancement :
"D:\Program Files\Microsoft Office\Office14\excel.exe" /e/auto c:\robot\runner-quotidien-V2.xlsm
Code fichier Excel :
thisworkbook
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
'fonction proposée par Tony Proctor sur le forum public de Microsoft : microsoft.public.vb.winapi
Private Function GetCmd() As String
Dim lpCmd As Long
lpCmd = GetCommandLine()
GetCmd = Space$(lstrlen(ByVal lpCmd))
lstrcpy ByVal GetCmd, ByVal lpCmd
End Function
Private Sub Workbook_Open()
'Si variable à l'ouverture de fichier excel = /auto > on est en mode robot> execute la macro,
'sinon en mode utilisateur on affiche juste le classeur.
If InStr(1, GetCmd(), "/auto") = 0 Then Exit Sub
Call runme
End Sub
Module1
Sub runme()
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("liste").Activate
ActiveSheet.Range("A1").Select
Do
' On parcourt la liste, et on sort si cellule vide.
ActiveCell.Offset(1, 0).Select
If Selection.Value = "" Then Exit Do
' Recuperation des valeur : depot lieu de stockage,
' Classeur nom du fichier excel
' feuilles : nom de la feuille à traiter
' Pdf : chemin de depot du pdf
' MailA, Objet, Message composante du mail.
depot = Selection.Value
classeur = Selection.Offset(0, 1).Value
feuilles = Selection.Offset(0, 2).Value
pdf = Selection.Offset(0, 3).Value
MailA = Selection.Offset(0, 4).Value
Objet = Selection.Offset(0, 5).Value
Message = Selection.Offset(0, 6).Value
'Traitement du rapport
MAJ_Rapport depot, classeur, feuilles, pdf, MailA, Objet, Message
Loop
Application.Quit
End Sub
Private Function MAJ_Rapport(Chemin, Fichier, FCalcul, SortiePDF, Destinataire, Sujet, CorpsMessage)
Dim Appli As Object
Dim Rapport As Object
'Creation d'un objet Excel, et d'un objet rapport dans l'object excel
Set Appli = CreateObject("Excel.Application")
Set Rapport = Appli.Workbooks.Open(Chemin + Fichier, 3)
Appli.Application.DisplayAlerts = False
Appli.Application.Visible = True
Rapport.Activate
Rapport.RefreshAll
'Pause dans la macro, le temps de rafraichir les données.
Call wait(20)
'Si sortie PDf demandé (Chemin existant)
If SortiePDF <> "" Then
Rapport.Sheets(FCalcul).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=SortiePDF, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
'Si envoie par mail demandé (destinataire existant)
If Destinataire <> "" Then
' On crée un fichier PDF tempo (la sorite PDF ci dessus n'etant pas obligatoire)
Nomtempo = "c:\temp\" + Fichier + ".pdf"
Rapport.Sheets(FCalcul).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Nomtempo, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Call Envoi_mail(Destinataire, Sujet, CorpsMessage, Nomtempo)
cmdshell = "cmd /c del " + Chr(34) + Nomtempo + Chr(34)
Shell cmdshell, vbHid
End If
' On ferme et on libere les objets.
Rapport.Close SaveChanges:=False
Set Rapport = Nothing
Appli.Application.Quit
Set Appli = Nothing
End Function
Sub Envoi_mail(Destinataire, Sujet, Message, PJ)
Dim Imsg As Object
Dim Iconf As Object
Dim Flds As Object
Set Imsg = CreateObject("cdo.message")
Set Iconf = CreateObject("cdo.configuration")
Set Flds = Iconf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.MonDomaine.fr"
.Update
End With
With Imsg
Set .Configuration = Iconf
.To = Destinataire
.From = "noreply@MonDomaine.fr"
.Subject = Sujet
.TextBody = Message
.AddAttachment PJ
.Send
End With
Set Flds = Nothing
Set Iconf = Nothing
Set Imsg = Nothing
End Sub
Sub wait(attendre)
temps = Time
debut = Minute(temps) * 60 + Second(temps)
Do
DoEvents
ecoule = (Minute(Time) * 60 + Second(Time)) - debut
If ecoule > attendre Then Exit Do
Loop
End Sub |
Partager