boucle

vatounet

XLDnaute Nouveau
Salut,

Je debarque en vba et macro excel, donc j'expose mon probleme en français :

En feuille 1 j'ai un tableau avec 3 colonnes, la premiere s'apelle 'station' et comporte des numeros de station.

J'ai une macro (3 sub) qui marche tres bien et effectue les operations suivantes :

Pour station=1 ou 2 ou 3 ou ...
selectionne la ou les lignes correspondantes,
copie les lignes sur la feuille 2,
'A ce moment mon unique graphique de la feuille 2 se met à jour'
selectionne le graphique,
exporte le graphique en .gif dans un dossier,

Genial, mais à chaque fois je suis obligé de taper le numero de la station dans ma macro.
j'aimerais donc que ma macro face cette manip en boucle pour toutes les valeurs de station, je galere....

Si vous avez des trucs et astuces des bouts de codes, j'accepte tout.
D'avance merci et bonne journée,

Fred
Je peut envoyer le code de la macro si besoin !
 

Hellboy

XLDnaute Accro
Bonjour vatounet

Je ne sais pas si je saisi comme il faut, mais je crois qu'il faut que tu utilisae une procédure évènementciel. Exemple:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Fait la procédure a vatounet
End Sub

Mais effectivement, si on a ton code, ça serait plus facile de voir si ma réponce te convient ou pas.
 
V

vatounet

Guest
Merci Hellboy pour ta reponse que je vais tester de ce pas,

J'étais en train d'écrire un brouillon de code comme ça (c'est certainement plein d'erreurs) :


sub selection()
dim station as long

for each station in range ('a2':'A?, la fin de mon tableau en feuil1?')
if station.value <> null then
ActiveSheet Application.Intersect(.Range(les lignes correspondants a station ????), .UsedRange).Select
end if
Selection.Copy
Sheets('Feuil2').Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Run ''test macro et vba.xls'!export'
Selection.ClearContents
next station
end sub

pas facile...

Voila le code original qui n'a pas la même structure

[Sub Selection_tableau()
i = 1
NombreLignes = 20
While i < NombreLignes + 1
If Cells(i, 1) = 2 Then
MesLignes = MesLignes & i & ':' & i & ','
End If
i = i + 1
Wend

MesLignes = Left(MesLignes, Len(MesLignes) - 1)

With ActiveSheet
Application.Intersect(.Range(MesLignes), .UsedRange).Select
End With

End Sub

Sub graphique()
'
' graphique Macro
' Macro enregistrée le 08/08/2005 par sigdbn
'

'
Sheets('Feuil2').Select
Range('A2:C26').Select
Selection.ClearContents
Sheets('Feuil1').Select
Application.Run ''test macro et vba.xls'!Selection_tableau'
Selection.Copy
Sheets('Feuil2').Select
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

Sub export()
'
' export Macro
' Macro enregistrée le 05/08/2005 par sigdbn
'

'
Application.Run ''test macro et vba.xls'!graphique'
Dim Graph As ChartObject
Dim NomFichier As String

NomFichier = Sheets(2).Range('A2') & ' ' & Format(Date, 'yyyy mm dd') & '_' & Format(Time, 'hh mm ss')

Set Graph = Sheets(2).ChartObjects(1)
Graph.Chart.export 'D:\\Mes documents\\Bases de donnees\\EXPORT GRAPHIQUE\\' & NomFichier & '.gif', 'GIF'

End Sub]
 

Hellboy

XLDnaute Accro
Bonjour vatounet

excuse moi du délais de réponse, mais je suis débordé depuis un certain temps.

Peux-tu me dire si tu as encore besoin d,aide et si oui, qu'est ce qui cloche. Joint ton fichier, on pourra gagné du temps.

merci !

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 502
Messages
2 089 026
Membres
104 008
dernier inscrit
jojo1966