Appel d'une macro Excel via script VBS

[NikoZozo]

Bonjour,

Voila j'ai déclaré une macro vba en Sub auto_open() dans un classeur xls.
Cette macro marche nickel ! lorsque je lance manuellement mon fichier, en double cliquant sur celui-ci moi même.

Par contre quand j'ouvre ce fichier à partir de mon script vbs ci-dessous, mon fichier s'ouvre, mais ma macro ne se lance pas en automatique.

Voila ce qui m'amène à vous poser la question suivante :

Que dois-je faire pour faire appel à ma macro à partir de mon vbs, pour que celle-ci s'execute en automatique à l'ouverture de mon fichier ?

Si vous aviez une autre idée (modification script VBA ..), merci de m'en faire part.

Voici mon petit bout de code VBS :

Set objExcel = CreateObject('Excel.Application')
Set objWorkbook = objExcel.Workbooks.Open('C:\\Fichier.xls')
objExcel.Visible = TRUE

et voici mon code VBA : (un peu à ralonge )

Sub Macro1()

Sub auto_open()



Dim MyDate
Dim MyTime
Dim Sujet
MyTime = Time
MyDate = Date - 1
Nsemaine = Format(Date, 'ww', vbUseSystemDayOfWeek, vbFirstFourDays)
Dim NumeroJour As Integer
NumeroJour = Weekday(Now, vbMonday) - 1

Sujet = 'Envoi Automatique : Taux : ' & MyDate

If NumeroJour = 0 Then

NumeroJour = 7
ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal' & Nsemaine - 1 & '.xls'

Sheets('samedi').Select
Range('D100').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal S' & Nsemaine - 1 & '.xls'
Sheets('samedi').Select
Range('D100').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux S'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO' & Nsemaine & '.xls'
Sheets('dimanche').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance' & Nsemaine - 1 & '.xls'
Sheets('samedi').Select
Range('D99').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT'
ActiveWorkbook.Save
ActiveWorkbook.Close


End If



If NumeroJour = 1 Then

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('lundi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux ED'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('lundi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('lundi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE V2_S' & Nsemaine & '.xls'
Sheets('lundi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT'
ActiveWorkbook.Save
ActiveWorkbook.Close


End If


If NumeroJour = 2 Then

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('mardi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux ED'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('mardi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('mardi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE V2_S' & Nsemaine & '.xls'
Sheets('mardi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT'
ActiveWorkbook.Save
ActiveWorkbook.Close



End If


If NumeroJour = 3 Then

ChDir 'C:\\Program Files\\StatsExcel2004\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('mercredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux ED'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('mercredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('mercredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE V2_S' & Nsemaine & '.xls'
Sheets('mercredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT'
ActiveWorkbook.Save
ActiveWorkbook.Close


End If



If NumeroJour = 4 Then

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('jeudi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux EDC'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('jeudi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('jeudi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE V2_S' & Nsemaine & '.xls'
Sheets('jeudi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT'
ActiveWorkbook.Save
ActiveWorkbook.Close



End If


If NumeroJour = 5 Then

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('vendredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux ED'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('vendredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('vendredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE V2_S' & Nsemaine & '.xls'
Sheets('vendredi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('D3').Select
ActiveSheet.PasteSpecial
Range('D2').Select
ActiveCell.FormulaR1C1 = 'Taux ATT GAB'
ActiveWorkbook.Save
ActiveWorkbook.Close



End If



If NumeroJour = 6 Then

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal ED V2_S' & Nsemaine & '.xls'

Sheets('samedi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'

Range('A3').Select
ActiveSheet.PasteSpecial
Range('A2').Select
ActiveCell.FormulaR1C1 = 'Taux EDC'
Range('B1').Select
ActiveCell.FormulaR1C1 = MyDate
Range('A1').Select
ActiveCell.FormulaR1C1 = 'Journée du :'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal SAN V2_S' & Nsemaine & '.xls'
Sheets('samedi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close
ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('B3').Select
ActiveSheet.PasteSpecial
Range('B2').Select
ActiveCell.FormulaR1C1 = 'Taux SAN'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal OPPO V2_S' & Nsemaine & '.xls'
Sheets('samedi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close

ChDir 'C:\\'
Workbooks.Open Filename:= _
'C:\\script\\TauxAcc.xls'
Cells(NumeroJour, 1).Select
Range('C3').Select
ActiveSheet.PasteSpecial
Range('C2').Select
ActiveCell.FormulaR1C1 = 'Taux OPPO'
ActiveWorkbook.Save
ActiveWorkbook.Close

ChDir 'C:\\classeurs'
Workbooks.Open Filename:= _
'C:\\Program Files\\Journal Assistance CE' & Nsemaine & '.xls'
Sheets('samedi').Select
Range('D21').Select
Selection.Copy
ActiveWorkbook.Close



End If

Application.Quit
End Sub


Merci d'avance pour votre aide.

NikoZozo

 

[Hervé]

bonjour nikozozo

joli pseudo et joli code.

sans test, essaye de placer ton code dans l'evenementielle Private Sub Workbook_Open() dans le module thisworkbook, au lieu de auto_open.

salut

 

[NikoZozo]

Bonjour Hervé,

Merci pour le pseudo et pour le code


Finalement, je viens de trouver. (pas sans mal, mais c'est bon)
Je fais appel à ma macro en automatique à partir de mon script VBS directement. Celui-ci etant placé en tâche planifié.

Voici donc mon code VBS opérationnel, cela pourrais surement servir pour d'autres personnes


Contenu du vbs :

Dim objExcel
Dim objWorkbook
Set objExcel = CreateObject('excel.application')
Set objWorkbook = objExcel.Workbooks.Open('c:\\Scripts\\MonFichier.xls')
objWorkbook.RunAutoMacros 1 'xlautoopen
objExcel.Run ('Macro1')
objExcel.Visible = True

Contenu de la macro :

Sub Macro1()
ActiveCell.FormulaR1C1 = '1'
Range('A2').Select
ActiveCell.FormulaR1C1 = '2'
Range('A1:A2').Select
Selection.AutoFill Destination:=Range('A1:A20'), Type:=xlFillDefault
Range('A1:A20').Select
Range('A1').Select
End Sub

Voila , en tout cas merci pour tout.
Bonne continuation.

NikoZozo

 

[Hervé]

bonjour niko

pour ma culture personnelle, avais-tu essayé ce que je te proposais. si oui, quelle etait le résultat ?

de plus, si je peux me permettre concernant ton code en macro1

il ne manquerait pas un range('a1').select au début ?

et si ton objectif est d'inscrire de A1 a A20, les chiffres de 1 à 20, tu peux essayer ce code un peu plus court :

Sub Macro1()
Dim i As Byte
For i = 1 To 20: Cells(i, 1) = i: Next i
End Sub

salut

 

[NikoZozo]

Re Hervé,

Pour ta première question, oui j'ai testé , c'est ok en action double clique sur le fichier pour l'ouvrir manuellement, comme le auto-open.

Mais lorsque je souhaite le faire ouvrir par mon script vbs celui-ci ne marche pas comme le auto-open.

Par contre avec cette méthode à l'interieur de mon script vbs, cela marche parfaitement :

objWorkbook.RunAutoMacros 1 'xlautoopen
objExcel.Run ('Macro1')

plus besoin de declarer une macro en auto-open

et pour le code suivant, oui tu as raison B):

Sub Macro1()
ActiveCell.FormulaR1C1 = '1'
Range('A2').Select
ActiveCell.FormulaR1C1 = '2'

En fait, c'etait juste pour donner un exemple, et surtout pour montrer qu'avec l'ouverture d'un classeur via un script vbs, pas besoin de definnir une macro en auto_open :woohoo:

Par contre, pourrais-tu m'aider pour cette petite chose:

Voila je t'explique, je souhaiterai qu'en vu des resultats obtenus dans ce classeur ci-joint dans les cellules allant de A3 à D3, faire une macro qui me coloris l'interieur de ces cellules avec une couleur differente suivant le pourcentage obtenu.

Voila les couleurs qu'il me faudrait avoir suivants les tranches de pourcentage :

De 0 % à 79 % couleur de la cellule ==> 'Rouge'

De 80 % à 90 % couleur de la cellule ==> 'jaune'

De 90 % à 100 % couleur de la cellule ==> 'vert'

Merci pour ton aide précieuse

A+, NikoZozo

 

[NikoZozo]

Ah il semblerai que j'ai oublié la pièce jointe, la voici
[file name=TestTaux.zip size=4530]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TestTaux.zip[/file]

 

[Hervé]

re nikozozo



petit consil, évite les évenementielles auto_open.

pour ton souci, tu pourrais tres bien le faire par mefc.

en piece jointe les deux propositions, mefc et vba.

salut [file name=TestTaux_20060427155353.zip size=7340]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TestTaux_20060427155353.zip[/file]

 

[NikoZozo]

Merci Hervé,

Comment ca marche le mefc ? le code est stocké ou ?

Ca ma l'air super mais comment voir la source dans mon classeur.

Merci pour tes lumières


Nicozozo

 

[mutzik]

Bonjour le fil

voir format / mise enforme conditionnelle

 

[Nikozozo]

Exact, je viens juste de m'en rendre compte !!!

mille pardon et merci encore

quel CON :S

Bonne fin d'après midi à vous.

NIkozozo