Discussion :

[BebertBCN]

Bonjour,

J'ai besoin de votre aide svp : j'ai un message "Compile error" parce j'ai deux Worksheet_Change sur la même sheet. J'ai vu sur des forums qu'il faut dans ce cas merger les deux codes mais je n'y arrive pas... Pourriez vous svp m’éclairer ?

Merci beaucoup !!

Code 1 :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If DebugMode Then GoTo Try
 
    '    On Error GoTo Catch_
    '    Dim rngFind As Range
    '    Dim rngCell As Range
    '    Dim strColumn As String
    '    Dim intFindColumn As Integer
    '    Dim intColumnOffset As Integer
    '    Application.EnableEvents = False
    '    Set rngFind = Cells.Find("Last Changed", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
    '    If Not rngFind Is Nothing Then
    '        If Target.Column = rngFind.Column Then
    '            Dim bUndo As Boolean
    '            With Application
    '                Dim objRange As Range
    '                For Each objRange In Target
    '                    bUndo = True: Exit For
    '                Next objRange
    '                If bUndo Then .Undo
    '            End With
    '        End If
    '    End If
 
    '    Set rngFind = Cells.Find("Commercial Team", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
    '    If Not rngFind Is Nothing Then
    '        intFindColumn = rngFind.Column
    '        If intFindColumn = Target.Column Then
    '            For Each rngCell In Target.Cells
 
    '                intColumnOffset = 1
 
    '                If rngCell.Value = "" Then rngCell.Offset(0, intColumnOffset).Value2 = "" _
 
    '            Next rngCell
    '
    '        End If
    '    End If
    'Catch_:
    '    Application.EnableEvents = True
 
    ' // raise errors by default in this Subroutine
    '    all unhandled errors will end up being caught by Catch:
    On Error GoTo Catch
 
    ' // vars
    Dim vntPivotCell As Variant
    Dim rngPivotTableAndNotesRange As Range
    Dim intNotesColumns As Integer
    Dim intPivotTables As Integer
    Dim intPivotTableColumns As Integer
 
    On Error Resume Next
    vntPivotCell = Target.PivotCell.PivotCellType
    If Not IsEmpty(vntPivotCell) And vntPivotCell >= 0 And vntPivotCell <= 9 Then GoTo Catch
 
    On Error GoTo Catch
 
    With Target.Parent
 
        For intPivotTables = 1 To .PivotTables.Count
 
            If Not Intersect(Target.EntireRow, .PivotTables(intPivotTables).TableRange2) Is Nothing Then
 
                Select Case .PivotTables(intPivotTables).Name
 
 
                Case PivotTableNamePT1
 
                    intNotesColumns = Sheets(NotesWorksheetNamePT1).Range(NotesIndexCellPT1).CurrentRegion.Columns.Count - 1
                    intPivotTableColumns = .PivotTables(intPivotTables).TableRange1.Columns.Count
                    Set rngPivotTableAndNotesRange = .PivotTables(intPivotTables).TableRange1.Resize(, intPivotTableColumns + intNotesColumns)
                    If Not Intersect(Target, rngPivotTableAndNotesRange) Is Nothing Then
 
                        Call UpdateNotes(PivotTableName:=PivotTableNamePT1, _
                                         PivotTableWorksheetName:=PivotTableWorksheetNamePT1, _
                                         NotesWorksheetName:=NotesWorksheetNamePT1, _
                                         NotesIndexCell:=NotesIndexCellPT1, _
                                         PivotTableFieldNames:=PivotTableFieldNamesPT1, _
                                         IndexDelimiter:=IndexDelimiterPT1, _
                                         TargetRange:=Target)
                    End If
 
                End Select
            End If
        Next intPivotTables
    End With
 
Try:
    Exit Sub
 
Catch:
    GoTo Try
 
End Sub

Code 2 :

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
Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

[ARTURO83]

Bonjour,

Sous cette forme là:

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change(ByVal Target As Range)
    'Ici toutes les déclarations de variables
 
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then
        '************Code 1*******************
    Else
        '************Code 2*******************
    End If
End Sub

Cdlt

[BebertBCN]

Salut Arturo,

Merci bcp pour ton retour, en fait mon probleme s'est plutot reformulé dans ce post :

https://www.developpez.net/forums/d1.../#post10571071

et malheuresement le code que tu me proposes ne fonctionne pas...

Peux tu stp jeter un oeil et me donner un coup de main..?

Merci bcp

Bebert

[ARTURO83]

Bonjour,

Aller décortiquer un programme qui traite les TCD n'est pas chose aisée du fait qu'on ne peut pas se représenter la structure du fichier.
Par contre, vous pouvez décrire ce que vous attendez le plus simplement et le plus clair possible.
Si je reprends votre demande initiale dans ce post, vous avez 2 bouts de code que vous attribuez à 2 "Private Sub Worksheet_Change", ce qui est évidemment impossible. Ma réponse vous donnait la façon de présenter la chose, il vous suffisait de l'adapter à votre tour. Si cela ne fonctionne pas, c'est peut-être aussi qu'il y a d'autres éléments qui n'ont pas été pris en compte.
Question: Quelles sont les cellules qui doivent réagir lorsqu'elles sont sélectionnées? leurs appliquer le code correspondant.
Exemple:

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change
     If Intersect(Target, Range("A6:A7")) Is Nothing Then
        '************Code 1*******************
     Elseif Intersect(Target, Range("H6:H7")) Is Nothing Then
        '************Code 2*******************
     Elseif Intersect(Target, Range("K6:K7")) Is Nothing Then
        '************Code 3*******************
     Else
       '************Code4 *******************
End If

Cdlt