Activation de donnees sur une autre page

Version imprimable

1 pièce(s) jointe(s)

Bonjour a tous!

J'ai ecrit une macro qui me permet de recuperer differentes donnees selon les calculs effectuees sur une page. Mais ces calculs se font en fonctions de donnees d'entrees qui sont sur une autre page. Je souhaite que ma macro se lance quand ces donnees d'entrees sont modifiees et cela ne marche pas alors que si je change les donnees d'entree sur la page sur laquelle les calculs se font je n'ai pas de pb...

Voici mon fichier excel avec mon code en PJ!

Merci!

Code:

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal CellulesColonneJ As Range)
 
Dim WsE As Worksheet
Set WsE = Worksheets("Sheet1")
 
Dim LigneDeTitre As Long
Dim LigneEnCours As Long
Dim TotalLigne As Single
Dim DebutCol As Long
Dim ColEnCours As Long
 
   If CellulesColonneJ.Count > 6 Then Exit Sub
 
   If Not Application.Intersect(CellulesColonneJ, WsE.Columns("B")) Is Nothing Then
        LigneDeTitre = 2
        LigneEnCours = LigneDeTitre + 1
        For LigneEnCours = LigneDeTitre + 1 To WsC.UsedRange.Rows.Count
            TotalLigne = Application.WorksheetFunction.Sum(Range(ActiveSheet.Cells(LigneEnCours, 46), ActiveSheet.Cells(LigneEnCours, 54)))
            If TotalLigne > 0 Then
                    ActiveSheet.Range("AR1") = ActiveSheet.Cells(LigneEnCours, 1)
                    ActiveSheet.Range("AR2") = ActiveSheet.Cells(LigneEnCours, 2)
                    ActiveSheet.Range("AR3") = ActiveSheet.Cells(LigneEnCours, 5)
                    DebutCol = 45
                    ColEnCours = DebutCol + 1
                    For ColEnCours = DebutCol + 1 To 60
                            If ActiveSheet.Cells(LigneEnCours, ColEnCours).Value <> "" Then
                                ActiveSheet.Range("AR4") = ActiveSheet.Cells(LigneDeTitre, ColEnCours)
                                Exit For
                            End If
                        Next
                Exit For
            Else
                    ActiveSheet.Range("AR1") = "no solution"
                    ActiveSheet.Range("AR2") = "no solution"
                    ActiveSheet.Range("AR3") = "no solution"
                    ActiveSheet.Range("AR4") = "no solution"
            End If
        Next
   End If
 
End Sub

04/07/2013, 20h18
Theze

Bonsoir,

Si les valeurs se trouvent sur une autre feuille que celle où est généré l'évènement "Change", il te faut récupérer ces valeurs en faisant référence à la feuille voulue et non à "ActiveSheet".
En général, on ne modifie pas le nom de l'argument "Target" car c'est plus compréhensible pour les autre mais bon ?

Hervé.
04/07/2013, 20h29
Daranc
en mettant ta macro dans un module standard
et ne te référant pas à Activesheet mais avec un
Code:

1 2 with sheet(x) end with
ne pourrais tu pas appeler ta macro avec l'évènement WorksheetChange?
04/07/2013, 23h29
Frizz

Bonsoir,

Merci de vos reponses mais Herve pourrais tu etre un peu explicite et me renvoyer un code avec ce que tu changerais? Il faut savoir que pour l'instant mon code se trouve sur la page "Combinaison" et que les donnees d'entree sont sur la page "Sheet1" (et c'est la qu'elles sont modifiees) et qu'elles sont reprises sur la page "Combinaison" par une simple formule.
Daranc je ne vois pas du tout ce que je suis supposee faire avec ce with sheet(x)...

Merci
05/07/2013, 04h31
nibledispo

activation de dpnnées sur une autre page

bonjour,

je ne suis pas en mesure de repondre sur le fons mais qu'est le WsC de la ligne 19 déclaré nul part ?

Cordialement.

Citation:

Envoyé par Frizz

Bonsoir,
Daranc je ne vois pas du tout ce que je suis supposee faire avec ce with sheet(x)...

Merci

je ne sais pas si ton prog est complet mais j'imaginais un truc de ce genre

Code:

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
Sub ta_macro()
Dim WsE As Worksheet
Set WsE = Worksheets("Sheet1")
 
Dim LigneDeTitre As Long
Dim LigneEnCours As Long
Dim TotalLigne As Single
Dim DebutCol As Long
Dim ColEnCours As Long
  With Sheets(2)
   If CellulesColonneJ.Count > 6 Then Exit Sub
 
   If Not Application.Intersect(CellulesColonneJ, WsE.Columns("B")) Is Nothing Then
        LigneDeTitre = 2
        LigneEnCours = LigneDeTitre + 1
        For LigneEnCours = LigneDeTitre + 1 To WsC.UsedRange.Rows.Count
            TotalLigne = Application.WorksheetFunction.Sum(.Range(.Cells(LigneEnCours, 46), .Cells(LigneEnCours, 54)))
            If TotalLigne > 0 Then
                    .Range("AR1") = .Cells(LigneEnCours, 1)
                   .Range("AR2") = .Cells(LigneEnCours, 2)
                   .Range("AR3") = t.Cells(LigneEnCours, 5)
                    DebutCol = 45
                    ColEnCours = DebutCol + 1
                    For ColEnCours = DebutCol + 1 To 60
                            If .Cells(LigneEnCours, ColEnCours).Value <> "" Then
                               .Range("AR4") = .Cells(LigneDeTitre, ColEnCours)
                                Exit For
                            End If
                        Next
                Exit For
            Else
                    .Range("AR1") = "no solution"
                    .Range("AR2") = "no solution"
                    .Range("AR3") = "no solution"
                    .Range("AR4") = "no solution"
            End If
        Next
   End If
   End With
End Su

ceci naturellement dans un module standard
et avec dans chaque feuille

Code:

1
2
3
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ta_macro
End Sub

05/07/2013, 18h21
Frizz

Bonjour,

Lorsque je mets en place le code que vous me donnez, un bug ("object required") se produit au niveau de la ligne de code :

Code:

If CellulesColonneJ.Count > 6 Then Exit Sub

Je suppose que cela vient du fait qu'on ne declare nul part ce que c'est que CellulesColonneJ...
05/07/2013, 21h14
Theze

Bonsoir,

C'est normal si tu as mis le code dans l'évènement "Change" de la feuille sans changer le nom de l'argument. Ici, "CellulesColonneJ" représente l'argument "Target" (tu l'as renommé de cette façon !) c'est pour ça que je t'ai dis qu'en général on ne modifie pas les noms des variables d'Excel !
Dans ton code, "ActiveSheet" représente quelle feuille "Sheet1" ou "Combinaison" ?

Hervé.

Activesheet correspond a "Combinaison".

J'avais bien compris cette histoire de changement de nom de Target et du coup j'avais remplace partout CellulesColonneJ par Target mais le meme bug avait lieu...

Je suis un peu perdue sur quoi mettre dans quelle feuille ou quel module je crois.
Pour l'instant j'ai dans un module independant ce code la :

Code:

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
Sub ma_macro()
 
Dim WsE As Worksheet
Set WsE = Worksheets("Sheet1")
 
Dim LigneDeTitre As Long
Dim LigneEnCours As Long
Dim TotalLigne As Single
Dim DebutCol As Long
Dim ColEnCours As Long
 
With Sheets(2)
 
  If Target.Count > 6 Then Exit Sub
 
   If Not Application.Intersect(Target, WsE.Columns("B")) Is Nothing Then
        LigneDeTitre = 2
        LigneEnCours = LigneDeTitre + 1
        For LigneEnCours = LigneDeTitre + 1 To 543
            TotalLigne = Application.WorksheetFunction.Sum(Range(.Cells(LigneEnCours, 46), .Cells(LigneEnCours, 54)))
            If TotalLigne > 0 Then
                    .Range("AR1") = .Cells(LigneEnCours, 1)
                    .Range("AR2") = .Cells(LigneEnCours, 2)
                    .Range("AR3") = .Cells(LigneEnCours, 5)
                    DebutCol = 45
                    ColEnCours = DebutCol + 1
                    For ColEnCours = DebutCol + 1 To 60
                            If .Cells(LigneEnCours, ColEnCours).Value <> "" Then
                                .Range("AR4") = .Cells(LigneDeTitre, ColEnCours)
                                Exit For
                            End If
                        Next
                Exit For
            Else
                    .Range("AR1") = "no solution"
                    .Range("AR2") = "no solution"
                    .Range("AR3") = "no solution"
                    .Range("AR4") = "no solution"
            End If
        Next
   End If
End With
End Sub

Et j'ai dans "combinaison" et "sheet1" ce code la :

Code:

1
2
3
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ma_macro
End Sub

Bonjour,

Tu n'es pas très précise dans tes explications mais je vais tenter de t'aider par rapport à ce que j'ai compris. J'ai mis des commentaires dans le code.
Ce code est à mettre dans le module de la feuille "Sheet1". Ce dernier pourrait être remplacé par une fonction dans Excel mais bon car je ne vois pas l'utilité de VBA mais bon, peut être veux-tu faire tes armes avec VBA ?

Code:

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Fe As Worksheet
    Dim LigneEnCours As Long
    Dim TotalLigne As Single
    Dim ColEnCours As Long
 
    If Target.Count > 6 Then Exit Sub
 
    Set Fe = Worksheets("Combinaison")
 
        If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
 
            With Fe
 
                'boucle sur les lignes 3 à 543
                For LigneEnCours = 3 To 543
 
                    'effectue un total de la colonne "AT" à la colonne "BB" pour chaque ligne parcourue
                    TotalLigne = Application.WorksheetFunction.Sum(.Range(.Cells(LigneEnCours, 46), .Cells(LigneEnCours, 54)))
 
                    'si le résultat est positif...
                    If TotalLigne > 0 Then
 
                        'inscrit les valeurs des colonnes A, B et E de la ligne en cours
                        'en ligne 1, 2 et 3 de la colonne "AR"
                        .Range("AR1") = .Cells(LigneEnCours, 1)
                        .Range("AR2") = .Cells(LigneEnCours, 2)
                        .Range("AR3") = .Cells(LigneEnCours, 5)
 
                        'ensuite, boucle de la colonne 46 à 60
                        For ColEnCours = 46 To 60
 
                            'si une cellule des colonnes n'est pas vide...
                            If .Cells(LigneEnCours, ColEnCours).Value <> "" Then
 
                                'inscrit la valeur de cette cellule en "AR4" puis fin de boucle
                                .Range("AR4") = .Cells(LigneDeTitre, ColEnCours)
                                Exit For
 
                            End If
 
                        Next ColEnCours
 
                        'fin de boucle si "TotalLigne" est positif
                        Exit For
 
                    Else
 
                        'inscrit "no solution" à chaque passage de la boucle si "TotalLigne" est inférieur ou égal à 0
                        'là, il y a mieux à faire !!!
                        .Range("AR1") = "no solution"
                        .Range("AR2") = "no solution"
                        .Range("AR3") = "no solution"
                        .Range("AR4") = "no solution"
 
                    End If
 
                Next LigneEnCours
 
            End With
 
        End If
 
End Sub

Hervé.