problème pour éxecuter 2 fois le même code à la suite

Version imprimable

Voir 40 message(s) de cette discussion en une page

26/06/2008, 22h35
cvdistri

problème pour éxecuter 2 fois le même code à la suite

Bonjour,

J'explique brièvement la fonction de mon code actuel.
Quand je saisi une référence dans la colonne "b" de mon tableur, en colonne "a","c" et "s" s'affiche des données qui sont stocké dans un fichier nomé tarif.

Maintenant je voudrai utiliser le même code, 2 fois pour la même saisie.

C'est à dire quand je saisie la référence en colonne "b" je veut aussi que des données s'affiche en colonne "m", "p" et "r" mais cela sont stocké dans un fichier différent de la première action.

J'ai essayé beaucoup de façon différente pour résoudre ce problème, mais comme je manque de base en vba, je n'arrive pas à trouver de solutions.

J'espère trouver de l'aide parmi vous.

D'avance merci.
26/06/2008, 22h59
fring

Bonjour,

Afin de partir sur une bonne base et ne pas discuter dans le vide, affiche nous ton code stp.

Voila le code en question:

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
    Dim lNo As Long
 
     If Target.Column = 2 And Target.Row >= 13 And Target.Row <= 32 Then
        If VarType(Target) <> vbEmpty Then
            RechRefTarif Target.Text, Target.Row
        Else
            lNo = Target.Row
            With ActiveSheet
 
                .Unprotect "vp-CV"
                .Range("A" & lNo) = ""
                .Range("C" & lNo) = ""
                .Range("G" & lNo) = ""
                .Range("H" & lNo) = ""
                .Range("K" & lNo) = ""
                .Range("L" & lNo) = ""
                .Range("M" & lNo) = ""
                .Range("N" & lNo) = ""
                .Range("P" & lNo) = ""
                .Range("Q" & lNo) = ""
                .Protect "vp-CV"
 
            End With
        End If
    End If
End Sub
 
Private Sub RechRefTarif(sRef As String, lNo As Long)
    Dim flle As Worksheet
    Dim iNbProd As Integer, iNb As Integer
    Dim rCel As Range
    Dim lProd As Long
 
     Load frmChoix
     frmChoix.Tag = lNo
On Error GoTo GestionErreur
    For Each flle In Workbooks("tarifs beta.xlsx").Worksheets
        iNbProd = Application.WorksheetFunction.CountIf(flle.Columns("A:A"), sRef)
        If iNbProd <> 0 Then
            Set rCel = flle.Columns("A:A").Find(What:=sRef, After:=flle.Range("A1"), LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If iNbProd >= 1 Then
                For iNb = 1 To iNbProd
                    With frmChoix.lstProd
                          .AddItem sRef
                          .Column(1, .ListCount - 1) = flle.Range("B" & rCel.Row)
                          .Column(2, .ListCount - 1) = flle.Range("M" & rCel.Row)
                          .Column(3, .ListCount - 1) = flle.Range("K" & rCel.Row)
                          .Column(4, .ListCount - 1) = flle.Name
                          .Column(5, .ListCount - 1) = rCel.Row
                    End With
                    Set rCel = flle.Columns("A:A").FindNext(After:=rCel)
                Next
            End If
        End If
    Next
    Select Case frmChoix.lstProd.ListCount
         Case 0
               MsgBox "Cette référence n'est pas valide !", vbOKOnly + vbCritical, "ERREUR DE SAISIE"
               Unload frmChoix
               Range("B" & lNo).Select
        Case 1
               Set flle = Workbooks("tarifs beta.xlsx").Worksheets(frmChoix.lstProd.Column(4, 0))
               lProd = frmChoix.lstProd.Column(5, 0)
               With ActiveSheet
                .Unprotect "vp-CV"
                .Range("A" & lNo) = flle.Range("B" & lProd)
                .Range("C" & lNo) = flle.Range("C" & lProd)
                .Range("S" & lNo) = flle.Range("F" & lProd)
                .Protect "vp-CV"
            End With
            Unload frmChoix
        Case Else
               frmChoix.Show
    End Select
    Exit Sub
 
GestionErreur:
    If Err.Number = 9 Then
        MsgBox "Veuillez ouvrir le classeur des tarifs", vbOKOnly + vbCritical, "ERREUR"
    Else
        MsgBox Err.Description, vbOKOnly + vbCritical, "ERREUR N° " & Err.Number
    End If
End Sub
 
Private Sub RazBL()
    ActiveSheet.Unprotect "vp-CV"
    Range("A13:H32").ClearContents
    Range("K13:R32").ClearContents
    Range("K3").ClearContents
    ActiveSheet.Protect "vp-CV"
End Sub

27/06/2008, 10h13
fring

Vu que tu automatises la tâches via l'événement Workbook_SheetChange, comment va t-il savoir qu'il faut aller chercher dans le classeur "toto" ou dans le classeur "titi" ? Comment va t-il savoir qu'il faut compléter les colonnes A C S ou les colonnes M P R ?

Il y a t-il un détail qui permet de faire la distinction ?
27/06/2008, 20h21
cvdistri

Je crois que je me lance encore dans quelque chose qui me dépasse. Je suis super débutant, je métrise Excel, mais vba j'essaye juste de l'apprivoiser en comprenant et modifiant des codes que l'ont ma fait.

Je pensé que ce que je voulais faire serai plus simple.

Si quelqu'un pourrai me guider pas à pas dans la modification du code actuel ce serai sympa. :king:
27/06/2008, 20h35
casefayere

Bonjour,
je pense que ton code tu devrais l'écrire dans

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

et ajouter ce que tuveux en spécifiant le nom du fichier

exemple :
workbooks("nomclasseur").worksheets("nomfeuille").range("m" &...)
27/06/2008, 20h47
fring

Citation:

Envoyé par cvdistri

Je suis super débutant, je métrise Excel, mais vba j'essaye juste de l'apprivoiser en comprenant et modifiant des codes que l'ont ma fait.

Je pensé que ce que je voulais faire serai plus simple.
Si quelqu'un pourrai me guider pas à pas dans la modification du code actuel ce serai sympa. :king:

Bin...répond simplement à ma question stp, ce n'est ni du VBA ni de l'Excel

Citation:

Comment va t-il savoir qu'il faut compléter les colonnes A C S ou les colonnes M P R ?

En clair, quelles données faut-il introduire dans les colonnes A C S et lesquelles dans les colonnes M P R ?

Cogite avec ça et adapte :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim x As Integer
If Range("b2").Value = "" Then
x = Range("b2").Row
    ActiveSheet.Unprotect
 
End If
With Workbooks("tarif.xls").Sheets("ex")
Range("a2") = .Range("a2")
Range("c2") = .Range("c2")
Range("s2") = .Range("s2")
End With
With Workbooks("clas1.xls").Sheets("feuil1")
Range("m2") = .Range("m2")
Range("p2") = .Range("p2")
Range("r2") = .Range("r2")
End With
End Sub

27/06/2008, 22h01
cvdistri

Mon but, est de réaliser deux fois ce que ce code fait en se servant de 2 base de données différentes pour remplir des champs par rapport à une seule saisie.

http://www.cv-distribution.com/divers/EXEMPLE.jpg

J'espère que c'est un peu plus claire, par contre pour chaque base de données je veus qu'apparaisse la boite de dialogue, si la référence saisie est présente deux fois dans les bases.

Citation:

Envoyé par casefayere

Cogite avec ça et adapte :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim x As Integer
If Range("b2").Value = "" Then
x = Range("b2").Row
    ActiveSheet.Unprotect
 
End If
With Workbooks("tarif.xls").Sheets("ex")
Range("a2") = .Range("a2")
Range("c2") = .Range("c2")
Range("s2") = .Range("s2")
End With
With Workbooks("clas1.xls").Sheets("feuil1")
Range("m2") = .Range("m2")
Range("p2") = .Range("p2")
Range("r2") = .Range("r2")
End With
End Sub

Ok je réfléchit sur le problème, merci

27/06/2008, 22h25
cvdistri

Je viens d'essayer de modifier et plus rien ne fonctionne :?

Même pas de débogage, rien ne se passe !

C'est la brasse coulé
27/06/2008, 22h32
fring

Citation:

Envoyé par cvdistri

J'espère que c'est un peu plus claire, par contre pour chaque base de données je veus qu'apparaisse la boite de dialogue, si la référence saisie est présente deux fois dans les bases.

Voilà enfin une info clairement donnée :king:

Question : les deux autres classeurs contenant les BD sont également ouverts ?
27/06/2008, 22h35
cvdistri

Oui, ils sont ouvert.

Bon...à l'aveugle, ça devrait ressembler à ceci :

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
67
68
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As Range, BD1 As Workbook, BD2 As Workbook, FL As Worksheet, Ref As String, Lig As Byte
Dim Verif1 As Integer, Verif2 As Integer, Result1 As String, Result2 As String, adresse1 As String
 
If Target.Count > 1 Or Application.Intersect(Target, Range("B13:B32")) Is Nothing Or Target.Value = "" Then Exit Sub
 
Ref = Target.Value
Lig = Target.Row
Set BD1 = Workbooks("Base de données 1.xlsx")
Set BD2 = Workbooks("Base de données 2.xlsx")
 
For Each FL In BD1.Worksheets
    Set C = FL.Range("A:A").Find(what:=Ref, lookat:=xlWhole)
    If Not C Is Nothing Then
        adresse1 = C.Address
        Verif1 = 1
        Result1 = "feuille " & FL.Name & " / cellule " & C.Address(0, 0)
        Cells(Lig, 1) = FL.Cells(C.Row, 2)
        Cells(Lig, 3) = FL.Cells(C.Row, 3)
        Cells(Lig, 4) = FL.Cells(C.Row, 4)
        Cells(Lig, 5) = FL.Cells(C.Row, 5)
 
        Do Until C Is Nothing
            Set C = FL.Range("A:A").FindNext(C)
            If Not C Is Nothing And C.Address <> adresse1 Then
                Verif1 = Verif1 + 1
                Result1 = "feuille " & FL.Name & " / cellule " & C.Address(0, 0)
            Else
                Set C = Nothing
            End If
        Loop
    End If
Next
 
For Each FL In BD2.Worksheets
    Set C = FL.Range("A:A").Find(what:=Ref, lookat:=xlWhole)
    If Not C Is Nothing Then
        adresse1 = C.Address
        Verif2 = 1
        Result2 = "feuille " & FL.Name & " / cellule " & C.Address(0, 0)
        Cells(Lig, 6) = FL.Cells(C.Row, 2)
        Cells(Lig, 7) = FL.Cells(C.Row, 3)
        Cells(Lig, 8) = FL.Cells(C.Row, 4)
 
        Do Until C Is Nothing
            Set C = FL.Range("A:A").FindNext(C)
            If Not C Is Nothing And C.Address <> adresse1 Then
                Verif2 = Verif2 + 1
                Result2 = "feuille " & FL.Name & " / cellule " & C.Address(0, 0)
            Else
                Set C = Nothing
            End If
        Loop
    End If
Next
 
If Verif1 > 1 Then
    MsgBox "La référence " & Ref & " a été trouvée " & Verif1 & " fois dans le classeur " & BD1.Name & Chr(10) & Result1
End If
 
If Verif2 > 1 Then
    MsgBox "La référence " & Ref & " a été trouvée " & Verif2 & " fois dans le classeur " & BD2.Name & Chr(10) & Result2
End If
 
Set BD1 = Nothing
Set BD2 = Nothing
 
End Sub

Excuses-moi fring, comme j'apprends aussi en meme temps, avant de voir ta réponse, j'ai préparé ce code

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
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim x As Range, y As String, lg As String, adresse
If ActiveCell = "" Then Exit Sub
If ActiveCell.Column = 2 Then
lg = ActiveCell.Row
With Workbooks("base 1.xls").Sheets("ex")
y = .Range("a2").End(xlDown).Offset(0, 0).Address
Set x = .Range("a:a").Find(ActiveCell.Value, LookIn:=xlValues)
  If Not x Is Nothing Then
        adresse = x.Address
        Do
            Range("a" & lg) = .Range("b" & lg)
            Range("c" & lg) = .Range("c" & lg)
            Range("d" & lg) = .Range("d" & lg)
            Range("e" & lg) = .Range("e" & lg)
            Set x = .Range("a" & lg).FindNext(x)
        Loop While Not x Is Nothing And x.Address <> adresse
    End If
End With
With Workbooks("base 2.xls").Sheets("ex")
y = .Range("a2").End(xlDown).Offset(0, 0).Address
Set x = .Range("a:a").Find(ActiveCell.Value, LookIn:=xlValues)
  If Not x Is Nothing Then
        adresse = x.Address
        Do
            Range("f" & lg) = .Range("b" & lg)
            Range("d" & lg) = .Range("c" & lg)
            Range("e" & lg) = .Range("d" & lg)
            Range("e" & lg) = .Range("e" & lg)
            Set x = .Range("a" & lg).FindNext(x)
        Loop While Not x Is Nothing And x.Address <> adresse
    End If
End With
End If
End Sub

peut-etre tu me dira ce que ça vaut

28/06/2008, 00h17
fring

Citation:

Envoyé par casefayere

Excuses-moi fring, comme j'apprends aussi en meme temps, avant de voir ta réponse, j'ai préparé ce code

YFO pas t'excuser ;)

2/3 petites choses il me semble en regardant vite fait :

Ce n'est pas l'événement Worksheet_SelectionChange mais l'événement Worksheet_Change

Il faut ajouter une petite sécurité en cas que l'utilisateur sélectionne plusieurs cellules en même temps sinon ça va couiner

Code:

If Target.Count > 1 Then Exit Sub

C'est bien la colonne B mais il faut limiter l'événement aux lignes 13 à 32

Tu limites la recherche à une feuille bien précise, d'après ce que j'ai vu dans le code initial de cvdistri, il faut effectuer la recherche dans chaque feuille.

Je me suis arrêté là ;)
28/06/2008, 00h34
cvdistri

J'ai une petite erreur après validation :
Je pense que c'est plus claire en images.

http://www.cv-distribution.com/divers/ERREUR1A.jpg

http://www.cv-distribution.com/divers/ERREUR1B.jpg
28/06/2008, 00h38
casefayere

a fring
envoyé par fring

Citation:

2/3 petites choses il me semble en regardant vite fait :

Merci des conseils
28/06/2008, 01h10
casefayere

à cvdistri,

je viens de recopier le code de FRING et je n'ai eu aucun problème à l'essayer

Bonne nuit

Bon...dur dur à cette heure :mouarf:

J'ai retravaillé un peu les deux boucles (il y avait d'autres petites coquilles), remplace les par celles-ci

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
For i = 1 To BD1.Sheets.Count
    Set C = BD1.Sheets(i).Range("A:A").Find(what:=Ref, lookat:=xlWhole)
    If Not C Is Nothing Then
        adresse1 = C.Address
        Verif1 = Verif1 + 1
        Result1 = Result1 & Chr(10) & "feuille " & BD1.Sheets(i).Name & " / cellule " & C.Address(0, 0)
        Cells(Lig, 1) = BD1.Sheets(i).Cells(C.Row, 2)
        Cells(Lig, 3) = BD1.Sheets(i).Cells(C.Row, 3)
        Cells(Lig, 4) = BD1.Sheets(i).Cells(C.Row, 4)
        Cells(Lig, 5) = BD1.Sheets(i).Cells(C.Row, 5)
 
        Do Until C Is Nothing
            Set C = BD1.Sheets(i).Range("A:A").FindNext(C)
            If Not C Is Nothing And C.Address <> adresse1 Then
                Verif1 = Verif1 + 1
                Result1 = Result1 & Chr(10) & "feuille " & BD1.Sheets(i).Name & " / cellule " & C.Address(0, 0)
            Else
                Set C = Nothing
            End If
        Loop
    End If
Next
 
For i = 1 To BD2.Sheets.Count
    Set C = BD2.Sheets(i).Range("A:A").Find(what:=Ref, lookat:=xlWhole)
    If Not C Is Nothing Then
        adresse1 = C.Address
        Verif2 = Verif2 + 1
        Result2 = Result2 & Chr(10) & "feuille " & BD2.Sheets(i).Name & " / cellule " & C.Address(0, 0)
        Cells(Lig, 6) = BD2.Sheets(i).Cells(C.Row, 2)
        Cells(Lig, 7) = BD2.Sheets(i).Cells(C.Row, 3)
        Cells(Lig, 8) = BD2.Sheets(i).Cells(C.Row, 4)
 
        Do Until C Is Nothing
            Set C = BD2.Sheets(i).Range("A:A").FindNext(C)
            If Not C Is Nothing And C.Address <> adresse1 Then
                Verif2 = Verif2 + 1
                Result2 = Result2 & Chr(10) & "feuille " & BD2.Sheets(i).Name & " / cellule " & C.Address(0, 0)
            Else
                Set C = Nothing
            End If
        Loop
    End If
Next

Remplace également

Code:

Dim FL As Worksheet

par

Code:

Dim i As integer

Voir 40 message(s) de cette discussion en une page