SUPER RESOLU - Macro qui Beug

[Usine à gaz]

Bonjour à toutes et à tous,

J'ai une macro qui beug et je n'arrive pas à trouver pourquoi.

Si vous pouviez m'aider ça m'arrangerai bien.

Voici la vilaine :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect Password:="Krameri"
If Not Intersect(Target, Range("L3:L2000")) Is Nothing And Target.Count = 1 Then
Pratique2.Show
End If
ActiveSheet.Unprotect Password:="Krameri"
If Not Intersect(Target, Range("F4:F2000,K4:K2000,L4:K2000,N4:N2000,P4:P2000")) Is Nothing Then
Call AjouteC33
Call AjouteD33
Call DLFA
ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = 0: Target.Select: Application.EnableEvents = 1 '...revient
End If
End Sub

Voici la photo :


Avec un grand Merci, je vous souhaite à toutes et à tous un bon WE

Amicalement,
Calimero,

 

[Staple1600]

Re : Macro qui Beug

Bonjour à tous

arthour973
Range ta photo dans un album et joins plutôt un fichier Excel contenant ton userform et ton code VBA.

 

[JCGL]

Re : Macro qui Beug

Bonjour à tous,

If Not Intersect(Target, Range("F4:F2000,K4:K2000,L4:K2000,N4:N2000,P4:P2000"))

Vérifie les plages : L4:K2000 ne doit il pas être K4:K2000.

A+ à tous

Edition : A tester

Code VBA:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ActiveSheet.Unprotect Password:="Krameri"
If Not Intersect(Target, Range("L3:L2000")) Is Nothing And Target.Count = 1 Then
MsgBox "Ouvre Pratique2.Show" 'Pratique2.Show
End If
If Not Intersect(Target, Range("F4:F2000,K4:K2000,N4:N2000,P42000")) Is Nothing Then
MsgBox "Lance AjouteC33, AjouteD33 et DLFA" 'Call AjouteC33
'Call AjouteD33
'Call DLFA
'ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
' ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = 0: Target.Select: Application.EnableEvents = 1 '...revient
End If
End Sub

 

[Usine à gaz]

Re : Macro qui Beug

Merci pour cette réponse si rapide mais j'ai le même souci.

Voici ce que j'ai fait avec votre macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ActiveSheet.Unprotect Password:="Krameri"
If Not Intersect(Target, Range("L3:L2000")) Is Nothing And Target.Count = 1 Then
MsgBox "Ouvre Pratique2.Show" 'Pratique2.Show
End If
If Not Intersect(Target, Range("F4:F2000,K4:K2000,L4:L2000,N4:N2000,P4:P2000")) Is Nothing Then
MsgBox "Lance AjouteC33, AjouteD33 et DLFA"
'Call AjouteC33
'Call AjouteD33
'Call DLFA
'ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
' ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = 0: Target.Select: Application.EnableEvents = 1 '...revient
End If
End Sub

ça bloque toujours là :
If Not Intersect(Target, Range("F4:F2000,K4:K2000,L4:L2000,N4:N2000,P42000")) Is Nothing Then

Je continue à chercher
Amicalement,
Calimero,

 

[Staple1600]

Re : Macro qui Beug

Re

arthour973
Dans ce cas, suis le conseil que je te donnais dans mon premier message, celui de 12h49

Pour infos
A mon sens, ces deux écritures désignent la même plage non ?

Sub test()
MsgBox Range("F4:F2000,K4:K2000,L4:L2000,N4:N2000,P4:P2000").Address
MsgBox Range("F4:F2000,K4:L2000,N4:N2000,P4:P2000").Address
End Sub

 

[Usine à gaz]

Re : Macro qui Beug

Re-bonjour,

Il me semble n'avoir qu'une fois cette ligne dans la macro : MsgBox Range("F4:F2000,K4:K2000,L4:L2000,N4:N2000,P42000").Address

J'avais pas vu votre premier message.

Voici le fichier en pièce jointe.
Dans la feuille F1, il faut cliquer sur "Rappel suivant"

Merci de votre aide,
Amicalement
Calimero,

 

[Staple1600]

Re : Macro qui Beug

Re

arthour973
Ce n'était qu'un exemple pour signifier que tu pouvais raccourcir ton écriture
puisque L et K sont des colonnes contiguës.

Une version allégée et simplifiée de ton fichier précédemment joint permettrait d'y voir plus clair

(trop de code à lire et de procédures imbriquées en l'état actuel)

 

[JCGL]

Re : Macro qui Beug

Bonjour à tous,

Peux-tu tester le fichier joint ?

A+ à tous

 

[Usine à gaz]

Re : Macro qui Beug

Re encore LOL
J'espère que cette version sera meilleure,
Amicalement,
Calimero,

 

[Usine à gaz]

Re : Macro qui Beug

Avec ton fichier, ça marche mais quand je mets la macro dans mon fichier, ça bloque au même niveau.

Donc, apparemment, ce n'est pas la macro mais un truc "autour".
Je cherche encore

Un grand merci de me répondre en ce jour en plus

 

[JCGL]

Re : Macro qui Beug

Bonjour à tous,

Mon code n'est pas exactement le même que le tien.

A+ à tous

 

[Usine à gaz]

Re : Macro qui Beug

Oui, j'ai remarqué.

Je te renvoie le fichier test avec ton code dans la feuille F1

 

[JCGL]

Re : Macro qui Beug

Bonjour à tous,

Peux-tu essayer :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ActiveSheet.Unprotect Password:="Krameri"
    If Not Intersect(Target, Range("L3:L2000")) Is Nothing And Target.Count = 1 Then
        Pratique2.Show
    Else
        If Not Intersect(Target, Range("F3:F2000")) Is Nothing Or _
           Not Intersect(Target, Range("K3:K2000")) Is Nothing Or _
           Not Intersect(Target, Range("L3:L2000")) Is Nothing Or _
           Not Intersect(Target, Range("N3:N2000")) Is Nothing Or _
           Not Intersect(Target, Range("P3:P2000")) Is Nothing Then
            MsgBox "Lance AjouteC33, AjouteD33 et DLFA", , "Action"  'Call AjouteC33
            'Call AjouteD33
            'Call DLFA
            'ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
            '    ActiveSheet.EnableSelection = xlUnlockedCells
            Application.EnableEvents = 0: Target.Select: Application.EnableEvents = 1    '...revient
        End If
    End If
End Sub

A+ à tous

 

[Usine à gaz]

Re : Macro qui Beug

ça marche cette fois-ci et je vais essayer de comprendre.

Un grand merci pour ce service en ce jour.

Amicalement,
Calimero,

 

[JCGL]

Re : Macro qui Beug

Bonjour à tous,

L'idéal aurait été d'utiliser Union() mais les plages ne sont pas contiguës donc j'ai tente de biaiser.

A+ à tous