Discussion :

[Matthieu32]

Bonjour,

J'ai une macro qui fonctionnait bien jusque là, mais depuis que j'ai mis cette macro sur l'onglet en question :

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_selectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A65000")) Is Nothing Then
If Target.Value <> "" Then
    Sheets.Add.name = Target.Value
    cellule_sél = Target.Value
    Call Info(cellule_sél)
End If
End If
End Sub

Cela ne fonctionne plus (incompatibilité de type). Peut être qu'il y aurait moyen de ne pas faire tourner la private sub tant que l'autre macro fonctionne.
Dites moi s'il vous faut le code de l'autre macro.

Merci d'avance
Bonne journée

[Philippe Tulliez]

Bonjour,
Difficile d'apporter une réponse pertinente avec des renseignements qui manque.

Vous écrivez "Cela ne fonctionne plus (incompatibilité de type)". Je crois devinez que c'est un message d'erreur, si oui à quelle ligne ?

Dites moi s'il vous faut le code de l'autre macro.

Qu'en pensez-vous ?
Si vous dites à un réparateur de vélo que la roue de votre bicyclette fait un drôle de bruit et que vous venez sans elle. Que va-t'il vous demandez ?

Outre la publication du code, entre les balises (#) prévues à cet effet dans l'éditeur, n'oubliez pas d'indiquer, le n° de la ligne publiée où a lieu le message d'erreur.

[Matthieu32]

En effet un Message d'erreur d'exécution 13 à la ligne 3

Code :

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

If Target.Value <> "" Then

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
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Sub ActualiserListe()
Dim i, a As Integer
Dim tableau() As String
 
Application.ScreenUpdating = False
 
nbligne = Sheets("BDD").Range("A1").End(xlDown).Row
 
ReDim tableau(nbligne - 1, 2)
i = 1
a = 0
 
For i = 1 To nbligne
    Do While Sheets("BDD").Cells(i, 13).Value <> ActiveSheet.Range("A2").Value
        i = i + 1
        If i > nbligne Then
            Exit Do
        End If
    Loop
    If Sheets("BDD").Cells(i, 17).Value = "Retrait" Then
        If IsDate(Sheets("BDD").Cells(i, 24)) And Sheets("BDD").Cells(i, 24) > Date Then
            GoTo encore_ok
        End If
    i = i + 1
    GoTo suivant
    End If
encore_ok:
        tableau(a, 0) = Sheets("BDD").Cells(i, 3).Value
        tableau(a, 1) = Sheets("BDD").Cells(i, 4).Value
        tableau(a, 2) = Sheets("BDD").Cells(i, 9).Value
        a = a + 1
suivant:
Next i
 
 
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
 
If nbligne > 100000 Then
    nbligne = 1
End If
 
For a = 0 To UBound(tableau)
    If tableau(a, 0) = "" Then GoTo suite
    var = Application.Match(tableau(a, 0), ActiveSheet.Columns(1), 0)
    If IsError(var) Then
        ActiveSheet.Cells(nbligne + 1, 1) = tableau(a, 0)
        ActiveSheet.Cells(nbligne + 1, 2) = tableau(a, 1)
        ActiveSheet.Cells(nbligne + 1, 3) = tableau(a, 2)
        nbligne = nbligne + 1
    End If
Next a
suite:
 
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
For a = 3 To nbligne
    mon_tableau = tableau()
    valeur_a_rechercher = ActiveSheet.Cells(a, 1)
    If in_array(mon_tableau, valeur_a_rechercher) = False Then
        If MsgBox("Le produit " & ActiveSheet.Cells(a, 1).Value & " n'apparait plus dans la base de données EPHY, voulez-vous le supprimer?", vbYesNo, "Demande de confirmation") = vbYes Then
            ActiveSheet.Cells(a, 1).EntireRow.Delete
            nbligne = nbligne - 1
        End If
    End If
Next a
 
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "A3:A" & nbligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A3:BZ" & nbligne)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Range("A3:BZ" & nbligne).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=MOD(LIGNE();2)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
    Range("A3:BZ" & nbligne).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
Application.ScreenUpdating = True
 
End Sub

Merci pour votre condescendance

[Philippe Tulliez]

Bonjour,
Si vous avez une erreur 13 à ligne 3 de votre première procédure publiée soit If Target.Value <> "" Then, cela signifie que vous avez sélectionné plus d'une cellule.

Pour pallier ce problème, vous devez au préalable tester que la plage sélectionnée ne contient qu'une seule cellule soit If Target.Count = 1 then

[EDIT]
Le deuxième code n'avait pas d'incidence effectivement dans ce cas précis mais si vous aviez indiqué dès le départ le numéro de la ligne en cause, la réponse aurait été immédiate




Voici un exemple du code corrigé mais vous pouvez bien entendu utilisé un And

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_selectionChange(ByVal Target As Range)
 If Target.Count = 1 Then
    If Not Intersect(Target, Range("A3:A65000")) Is Nothing Then
      If Target.Value <> "" Then
        Sheets.Add.Name = Target.Value
        cellule_sél = Target.Value
        Call Info(cellule_sél)
       End If
    End If
 End If
End Sub

[Matthieu32]

Merci bien, ça marche nickel!

Bonne journée