macro pour reporter dans classeur fermé

Version imprimable

BONJOUR

pour commencer je tiens à vous remercier pour votre aide .
j'essaie d'écrire une macro qui va me permettre de reporter directement les champs désignés sans ouverture du fichier cible.

je bloque quand je veux lancer la recherche sur le fichier cible .

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long
    Dim cible As String
    Dim Batch As Single
    Dim prs As String
 
    'Vérifier si la cellule concernée par le changement fait partie de la plage F11:ED11
    Set C = Application.Intersect(Target, Range("D4:D100"))
    If Not C Is Nothing And Target.Count = 1 Then
    'stocker la cellule de la ligne changé de la colonne "A" afin de faire une recherche plutard
    Ligne = Target.Row
    cible = Range("A" & Ligne)
    prs = ("d" & Ligne)
 
    'Test pour prendre la valeur de la colonne F si elle existe sinon on prend la valeur E
    'If ("F" & ligne) Is Empty Then
    'batch = ("E" & ligne)
    'Else
    'batch = ("F" & ligne)
    'End If
        MsgBox "Le PRS Du Code Article " & cible & " Vient D'être Changée"
 
     'stocker la valeur de la cellule changé dans une variable afin la reporter dans un autre classeur
        Call Test(Target.Value, Target.Column)
    End If
End Sub
 
Sub Test(cible, prs)
Dim x As Long
Dim Val As Range
 
'dans cette partie je veux écrire sans ouverture du fichier suivant
'Workbooks.Open Filename:="C:\Documents and Settings\FR22034\Bureau\mars\Quotationtemplate_Rev05.xlsm", IgnoreReadOnlyrecommended:=True, WriteResPassword:="pg"
 
 Fichier = Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 If Fichier <> False Then
 Set Wbk = Workbooks.Open(Fichier)
 Application.DisplayAlerts = True
 With Wbk.Worksheets("Cables data")
 'cette ligne provoque une erreur
    x = Application.Match(cible, Worksheets("Cables data").Columns("c:c"), 0)
    If x = 0 Then
    MsgBox "Code Article " & cible & " non trouvée."
        Else
           MsgBox "Le Code Article" & cible & "est dans la ligne: " & x
            'ThisWorkbook.Worksheets("Cables data").Cells(x, 11).Value = Prs
            'ThisWorkbook.Worksheets("Cables data").Cells(x, 12).Value = batch
 
       End If
    End With
    End If
 
 
    Wbk.Saved = True
    'Wbk.Closed = True
    Set Wbk = Nothing
 
End Sub

28/03/2012, 16h28
Daniel.C

Bonjour,

Quel est le message d'erreur. As-tu vérifié que la valeur de "cible" se trouvait bien dans la plage cherchée ?
28/03/2012, 17h04
varik

ça me retourne une incompatibilité de type !!

il cherche la valeur de la cellule changé et non la valeur de la cellule que j'ai désigné ...

merci
28/03/2012, 17h57
Daniel.C

Citation:

il cherche la valeur de la cellule changé et non la valeur de la cellule que j'ai désigné ...

Tu peux expliquer ?
Un peu au hasard, essaie :

Code:

x = Application.Match(cible, .Columns("c:c"), 0)

au lieu de :

Code:

x = Application.Match(cible, Worksheets("Cables data").Columns("c:c"), 0)
29/03/2012, 14h21
varik

bonjour et merci pour l'aide .

quand je change un prix dans la colonne "D",je prend le code article correspondant dans la colonne "A" .

j'effectue ensuite une recherche sur ce code dans la colonne "c" du fichier désigné afin de reporter la date du changement du prix ,le prix, et un autre champs .

l'erreur que j'ai est que la valeur cible prend la valeur du prix lors du changement et non du code article. je pense que j'ai fait une erreur dans la fonction Worksheet_Change.
29/03/2012, 15h17
Daniel.C

Avec un peu de chance. La variable "cible" de la macro WorkSheet_Change correspond à la colonne A. La variable passée en paramètre à la macro Test correspond à la cellule de la colonne D modifiée.

la variable cible prend le code à chercher mais par contre j'ai toujours une incompatibilité de type, j'ai essayé en variant mais ça ne donne rien!!!

ça me renvoie sur l'erreur à la ligne suivante et ça me dit que x=0

x = Application.Match(CIBLE, Worksheets("Cables data").Columns("c:c"), 0)

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long
    Dim Batch As Single
    Dim prs As String
    Dim CIBLE As Variant
    'Vérifier si la cellule concernée par le changement fait partie de la plage F11:ED11
    Set C = Application.Intersect(Target, Range("D4:D100"))
    If Not C Is Nothing And Target.Count = 1 Then
    'stocker la cellule de la ligne changé de la colonne "A" afin de faire une recherche plutard
    Ligne = Target.Row
    CIBLE = Range("A" & Ligne)
    prs = ("d" & Ligne)
 
    'Test pour prendre la valeur de la colonne F si elle existe sinon on prend la valeur E
    'If ("F" & ligne) Is Empty Then
    'batch = ("E" & ligne)
    'Else
    'batch = ("F" & ligne)
    'End If
        MsgBox "Le PRS Du Code Article " & CIBLE & " Vient D'être Changée"
 
     'stocker la valeur de la cellule changé dans une variable afin la reporter dans un autre classeur
        Call Test(CIBLE, prs)
    End If
End Sub
 
Sub Test(CIBLE, prs)
Dim x As Long
Dim Val As Range
 
'dans cette partie je veux écrire sans ouverture du fichier suivant
'Workbooks.Open Filename:="C:\Users\varik\Desktop\Avril\Quotationtemplate_Rev05.xlsm", IgnoreReadOnlyrecommended:=True, WriteResPassword:="pg"
 
 Fichier = Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 If Fichier <> False Then
 Set wbk = Workbooks.Open(Fichier)
 Application.DisplayAlerts = True
 With wbk.Worksheets("Cables data")
    x = Application.Match(CIBLE, Worksheets("Cables data").Columns("c:c"), 0)
   If x = 0 Then
            MsgBox "Code Article " & CIBLE & " non trouvée."
        Else
            MsgBox "Le Code Article" & CIBLE & "est dans la ligne: " & x
            'ThisWorkbook.Worksheets("Cables data").Cells(x, 11).Value = Prs
            'ThisWorkbook.Worksheets("Cables data").Cells(x, 12).Value = batch
 
       End If
    End With
    End If
 
 
    'wbk.Saved = True
    'wbk.Close = True
    'Set wbk = Nothing
 
End Sub

29/03/2012, 17h53
Daniel.C

Est-ce que tu as essayé :

Code:

x = Application.Match(CIBLE, .Columns("c:c"), 0)

au lieu de :

Code:

x = Application.Match(CIBLE, Worksheets("Cables data").Columns("c:c"), 0)

Si oui, mets tes classeurs en pièce jointe en effaçant les données confidentielles.

je reviens pour dire que j'ai changé de méthode pour effectuer ma recherche ; ça marche mais il me manque ma partie ou je dois faire un test sur le contenu de deux cellules .

je m'explique , je prend le contenu de la cellule de la colonne f correspondante à la ligne sujet à modification et si le contenu est vide je prends le contenu de la cellule à coté .

je sais pas si c'est usuelle avec un if ,je pense qu'un case serait plus approprié ; j'attend vos recommandations .

merci d'avance

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long
    Dim Batch As Single
    Dim prs As String
 
    Set C = Application.Intersect(Target, Range("D4:D100"))
    If Not C Is Nothing And Target.Count = 1 Then
 
    Ligne = Target.Row
    CIBLE = Range("A" & Ligne)
    prs = Range("d" & Ligne)
 
    'Test pour prendre la valeur de la colonne F si elle existe sinon on prend la valeur E
    'If ("F" & ligne) Is Empty Then
    'batch = ("E" & ligne)
    'Else
    'batch = ("F" & ligne)
    'End If
        MsgBox "Le PRS Du Code Article " & CIBLE & " Vient D'être Changée"
 
 
        Call Test(CIBLE, prs)
    End If
End Sub
 
Sub Test(CIBLE, prs)
Dim x As Variant
Dim Val As Range
 
 
'dans cette partie je veux écrire sans ouverture du fichier suivant
'Workbooks.Open Filename:="C:\Users\varik\Desktop\Avril\Quotationtemplate_Rev05.xlsm", IgnoreReadOnlyrecommended:=True, WriteResPassword:="pg"
 
 Fichier = Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 If Fichier <> False Then
 Set wbk = Workbooks.Open(Fichier)
 Application.DisplayAlerts = True
 With wbk.Worksheets(2)
 Set Val = .Columns(3).Find(CIBLE, LookIn:=xlValues)
 If Not Val Is Nothing Then
   MsgBox "Le Code Article" & CIBLE & "est dans la ligne: " & Val.Row
        .Cells(Val.Row, 11).Value = prs
        '.Cells(val.row, 12).Value = Batch
        Else
    MsgBox "Code Article " & CIBLE & " non trouvée."
 
 
       End If
    End With
    End If
 
 
    'wbk.Saved = True
    'wbk.Close = True
    'Set wbk = Nothing
 
End Sub

29/03/2012, 18h48
Daniel.C

Il n'y a pas de manière préférable, c'est au goût de chacun.
29/03/2012, 21h04
varik

merci pour votre collaboration :)