CREE UNE MACRO QUI S'execute automatiquement

rak

XLDnaute Junior
bjr j'aimerai que ma macro s'execute une fois par semaine automatiquement jai vu certaint forum parler de tache palnifie mais comment faire :confused:
je ne voeux pas que cette macro s'execute automatiquement apres chaques ouverture mais qu'il s'execute une fois par semaine merci


:D

voici mon script :)
Macro1 Macro
' Macro enregistrée le 28/05/2009 par RESA3
'

'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\stat\stat05.mdb;Mode=Share Deny Write;Extended Propert" _
, _
"ies="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:" _
, _
"Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password" _
, _
"="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLE" _
, "DB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("inscription")
.Name = "stat05"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "D:\stat\stat05.mdb"
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
Columns("Q:Q").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Columns("P:p").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.NumberFormat = "#,##0 $"
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Rows("1:1").Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
Selection.AutoFilter Field:=13, Criteria1:="A"
ActiveWindow.SmallScroll Down:=243
ActiveWindow.ScrollRow = 8161
ActiveWindow.ScrollRow = 8177
ActiveWindow.ScrollRow = 8224
ActiveWindow.ScrollRow = 8255
ActiveWindow.ScrollRow = 8318
ActiveWindow.ScrollRow = 8412
ActiveWindow.ScrollRow = 8490
ActiveWindow.ScrollRow = 8584
ActiveWindow.ScrollRow = 8678
ActiveWindow.ScrollRow = 8741
ActiveWindow.ScrollRow = 8788
ActiveWindow.ScrollRow = 8835
ActiveWindow.ScrollRow = 8851
ActiveWindow.ScrollRow = 8882
ActiveWindow.ScrollRow = 8929
ActiveWindow.ScrollRow = 9007
ActiveWindow.ScrollRow = 9070
ActiveWindow.ScrollRow = 9117
ActiveWindow.ScrollRow = 9195
ActiveWindow.ScrollRow = 9289
ActiveWindow.ScrollRow = 9336
ActiveWindow.ScrollRow = 9430
ActiveWindow.ScrollRow = 9508
ActiveWindow.ScrollRow = 9571
ActiveWindow.ScrollRow = 9649
ActiveWindow.ScrollRow = 9712
ActiveWindow.ScrollRow = 9759
ActiveWindow.ScrollRow = 9806
ActiveWindow.ScrollRow = 9853
ActiveWindow.ScrollRow = 9884
ActiveWindow.ScrollRow = 9931
ActiveWindow.ScrollRow = 9978
ActiveWindow.ScrollRow = 10010
ActiveWindow.ScrollRow = 10025
ActiveWindow.ScrollRow = 10072
ActiveWindow.ScrollRow = 10104
ActiveWindow.ScrollRow = 10135
ActiveWindow.ScrollRow = 10151
ActiveWindow.ScrollRow = 10166
ActiveWindow.ScrollRow = 10198
ActiveWindow.ScrollRow = 10213
ActiveWindow.ScrollRow = 10245
ActiveWindow.ScrollRow = 10292
ActiveWindow.ScrollRow = 12077
ActiveWindow.ScrollRow = 12108
ActiveWindow.ScrollRow = 12124
ActiveWindow.ScrollRow = 12140
ActiveWindow.ScrollRow = 12155
ActiveWindow.ScrollRow = 12171
ActiveWindow.ScrollRow = 12187
ActiveWindow.ScrollRow = 12218
ActiveWindow.ScrollRow = 12249
ActiveWindow.ScrollRow = 12265
ActiveWindow.ScrollRow = 12281
ActiveWindow.ScrollRow = 12296
ActiveWindow.ScrollRow = 12312
ActiveWindow.ScrollRow = 12328
ActiveWindow.ScrollRow = 12343
ActiveWindow.ScrollRow = 12359
ActiveWindow.ScrollRow = 12390
ActiveWindow.ScrollRow = 12406
ActiveWindow.SmallScroll Down:=36
Range("N12499").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-12497]C:R[-1]C)"
Range("N12499").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

End Sub
 

jeanpierre

Nous a quitté
Repose en paix
Re : CREE UNE MACRO QUI S'execute automatiquement

Bonjour rak,

Déjà, commence par supprimer tous les : ActiveWindow.ScrollRow =x
x correspond à un numéro de ligne.

Ensuite : Démarrer/Panneau de configuration et Tâches planifiées, tu crées une nouvelle tâche et tu te laisse guider. Tu selectionnes pour finir le jour et l'heure que tu souhaites.

Bon après-midi.

Jean-Pierre

Oublié de te dire : il faut que ta macro soit placée dans le ThisworkBook par une évennementielle workbook_Open. Une petite recherche sur ce mot et c'est bon.
 
Dernière édition:

rak

XLDnaute Junior
Re : CREE UNE MACRO QUI S'execute automatiquement

merci pour ta reponse pierre jai effectuer les modification au niveau de mon script , mais je n'arrive pas a placer ma macro dans le ThisworkBook par une évennementielle workbook_Open a vrai dire je suis un novice en macro.


voici le lien pour acceder au fichier il ne s'agit que d'un exemple.

Ce lien n'existe plus

merci beaucoup:)
 

rak

XLDnaute Junior
Re : CREE UNE MACRO QUI S'execute automatiquement

re avec un peu de recherche sur le net jai trouver la solution mais je ne voeux pas que la macro s'execute apres chaques ouverture du classeur je voudrait quelle s'effectue q'une seule fois par semaine
solution jai realise dans thisworkbook
workopen()
call macro1
end sub
 

mromain

XLDnaute Barbatruc
Re : CREE UNE MACRO QUI S'execute automatiquement

bonjour rak, jeanpierre,

tu pourrais utiliser une feuille cachée où en A1 tu met le numéro de la semaine,
ensuite, en début de macro, tu écris :
Code:
Private Sub Workbook_Open()
With ThisWorkbook.Sheets("MaFeuilleCachée")
    If Not Application.WorksheetFunction.WeekNum(Now) = .Range("A1") Then
        .Range("A1") = Application.WorksheetFunction.WeekNum(Now)
        
        ....
        ....
        ....
        ....
        
    End If
End Sub

cela te permet d'exécuter le code une fois par semaine.

a+
 

JNP

XLDnaute Barbatruc
Re : CREE UNE MACRO QUI S'execute automatiquement

Bonjour Rak, JeanPierre :),
Si tu mets une date d'il y a plus d'une semaine en A1 de la feuil2, tu peux mettre ce code dans ThisWorkBook
Code:
Private Sub Workbook_Open()
If Sheets("Feuil2").Range("A1") - Now > 7 Then
Call macro1
Sheets("Feuil2").Range("A1") = Sheets("Feuil2").Range("A1") + 7
End Sub
Chaque fois que tu ouvriras ton fichier et que la semaine sera écoulée, la macro sera lancée et la date réactualisée.
Bonne journée :cool:
Ajout : Bonjour MRomain. Même raisonnement que toi, mais en jours et non en semaine.
 
Dernière édition:

jeanpierre

Nous a quitté
Repose en paix
Re : CREE UNE MACRO QUI S'execute automatiquement

Re,

Ton fichier en retour

Dans ThisWorkBook seulement ceci : Private Sub Workbook_Open()
Call Macro1
End Sub
et j'ai placé ton code dans un module plus encore un peu de ménage.

Tu enregistres ce fichier et tu l'ouvres à nouveau pour vérifier que la macro s'éxécute bien.

Edit : Ouh là, trop vite pour moi, bonjour mromain, JNP, je suis parti sur le planificateur de tâche qui ouvre le fichier, peut-être est-ce une erreur ?
 

Pièces jointes

  • Suivi%20commercial%202008_2009copie.xls(1).zip
    7.8 KB · Affichages: 57
Dernière édition:

rak

XLDnaute Junior
Re : CREE UNE MACRO QUI S'execute automatiquement

MERCI CELA MARCHe:D:D:D:D TRES BIEN LA MACRO S'EXECUTE AUTOMATIQUEMENT APRES QUE JAVOIR EFFECTUER UNE PLANNIFICATION DE TACHE SOUS WINDOWS ::eek::eek::eek::eek:mais j'aimerais aller un peu plus loin si c possible ; je m'explique j'aimerais apres avoir mis un filtre automatique et selectionnée dans la colonne exercice A , selectionner automatiquement les donee de la semaine passée car actuellement je fait cette selection manuellement grace au filtre personalise valeur superieure et valeur inferieure mais je me demande si cela est possible :confused::confused:
merci:cool::cool:
je vois envoie une exemple par contre je n'arrive pas a ouvrir les dossiers zippe :eek::eek::eek:
c'est pour cela que j'envoie mes fichier par l'intermediare de megaupload.

Ce lien n'existe plus
 

jeanpierre

Nous a quitté
Repose en paix
Re : CREE UNE MACRO QUI S'execute automatiquement

Bonjour rak, JNP, mromain,

Tu n'arrives pas à ouvrir les fichiers zippés ???,
soit tu es en entreprise avec un pare-feu, vois ton administrateur.
soit tu es chez-toi, auquel cas revoir les paramétrage de ton propre pare-feu.

Maintenant, que tu n'arrives pas à ouvrir n'empêche pas de zipper tes fichiers... Non ???

Bonne journée.

Jean-Pierre
 

rak

XLDnaute Junior
Re : CREE UNE MACRO QUI S'execute automatiquement

voila le script que j'obtient apres avoir effectuer le filtre test Macro
' Macro enregistrée le 29/05/2009 par RESA3
'

'
Selection.AutoFilter Field:=4, Criteria1:=">=20090511", Operator:=xlAnd, _
Criteria2:="<=20090516"
End Sub

et j'aimerai que cette opreration s'effectue automatiquement en prenant en compte les date de la semaine dernieres




merci beaucoup
 

Discussions similaires

Statistiques des forums

Discussions
312 421
Messages
2 088 269
Membres
103 800
dernier inscrit
mat37974