macro pour reporter dans classeur fermé

**varik** · 28/03/2012, 15h57

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Daniel.C** · 28/03/2012, 16h28

Bonjour,

Quel est le message d'erreur. As-tu vérifié que la valeur de "cible" se trouvait bien dans la plage cherchée ?

**varik** · 28/03/2012, 17h04

ç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

**Daniel.C** · 28/03/2012, 17h57

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**varik** · 29/03/2012, 14h21

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.

**Daniel.C** · 29/03/2012, 15h17

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.

**varik** · 29/03/2012, 16h35

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Daniel.C** · 29/03/2012, 17h53

Est-ce que tu as essayé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**varik** · 29/03/2012, 17h54

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Daniel.C** · 29/03/2012, 18h48

Il n'y a pas de manière préférable, c'est au goût de chacun.

**varik** · 29/03/2012, 21h04

merci pour votre collaboration

macro pour reporter dans classeur fermé

Macros et VBA Excel

Discussions similaires

Partager

Partager