pb sur macro

Le
Nicoh
Bonjour à tous,

Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.

D'avance merci pour votre patience et votre aide.

Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)

Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If

If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

'macro plage 1

If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value: Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If

'macro plage 2

If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) =
Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 3

If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If


'macro plage 4

If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) =
Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 5

If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) = "2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) = "1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo, Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If

End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Youky
Le #4318621
Salut,
Ta macro tourne chez moi comme tu le souhaite.
La fusion de tes cellules à cet endroit à peut être été modifées
Je vois que cette seule solution
en fenetre Execution au cas ou... lance cette ligne et <Enter>
Application.EnableEvents = True

ici j'ai raccourci le début de la macro, le restant étant inchangé
Youky

Dim iSect As Range, c As Range
Set iSect = Intersect(Target,
Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If

If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

'macro plage 1
et le restant de la macro inchangée


"Nicoh"
Bonjour à tous,

Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et
aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche
encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.

D'avance merci pour votre patience et votre aide.

Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)

Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect
As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If

If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

'macro plage 1

If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value:
Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If

'macro plage 2

If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 3

If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing
Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If


'macro plage 4

If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 5

If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing
Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) =
"2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or
Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) =
"1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo,
Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If

End Sub




Nicoh
Le #4318051
Salut,

Merci de ta réponse. En fait, j'ai résolu le problème en enlevant Exit Sub
dans les plages concernées et pour le moment tout fonctionne parfaitement. Je
suppose qu'il y aura un problème plus tard car Exit Sub doit servir à qqch,
mais j'improviserais à ce moment là.
Par contre, je vais changer le début dès que j'ai un peu de temps (c'est la
course aujourd'hui) comme tu l'as fait et te tiens au courant si pb par ton
mail perso comme la fois dernière.

En tout cas encore merci beaucoup pour ton aide,

Nicoh


Salut,
Ta macro tourne chez moi comme tu le souhaite.
La fusion de tes cellules à cet endroit à peut être été modifées
Je vois que cette seule solution
en fenetre Execution au cas ou... lance cette ligne et <Enter>
Application.EnableEvents = True

ici j'ai raccourci le début de la macro, le restant étant inchangé
Youky

Dim iSect As Range, c As Range
Set iSect = Intersect(Target,
Range("ab37:ab56,ba6:cc6,ba16:cc16,af37:af56,i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If

If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

'macro plage 1
et le restant de la macro inchangée


"Nicoh"
Bonjour à tous,

Certains d'entre vous (Youky, FxM, Jacky, LSteph, JB, ...) m'ont développé
des macros qui misent bout à bout donnent le résultat suivant (voir plus
bas). Jusqu'à la semaine dernière tout se passait normalement et
aujourd'hui
il y a des "fonctions" qui ne sont plus actives.
Par exemple, en BA16 si on répond OUI à la question "est-ce un NEW ?", ça
marche, mais la question ne se pose plus en BC16 !
Par contre en AF 37 à la même question ça marche et en AF39 ça marche
encore !
Quelqu'un peut-il me renseigner sur l'éventuelle manip à faire, c'est trop
fort pour moi.

D'avance merci pour votre patience et votre aide.

Ci-dessous la macro :
Private Sub Worksheet_Change(ByVal Target As Range)

Dim iSect As Range, jSect As Range, kSect As Range, lSect As Range, mSect
As
Range, c As Range
Set iSect = Intersect(Target, Range("ab37:ab56"))
Set jSect = Intersect(Target, Range("ba6:cc6"))
Set kSect = Intersect(Target, Range("ba16:cc16"))
Set lSect = Intersect(Target, Range("af37:af56"))
Set mSect = Intersect(Target, Range("i58:ai58"))
If Not iSect Is Nothing Then
For Each c In iSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not jSect Is Nothing Then
For Each c In jSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not kSect Is Nothing Then
For Each c In kSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not lSect Is Nothing Then
For Each c In lSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(1, 0).ClearContents
Application.EnableEvents = True
Next
End If
If Not mSect Is Nothing Then
For Each c In mSect.Cells
Application.EnableEvents = False
If c.Value = "" Then _
c.Offset(-1, 0).ClearContents
Application.EnableEvents = True
Next
End If

If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

'macro plage 1

If Not Intersect(Target, Range("ba6:cc6")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", 4, Application.UserName)
If question = 7 Then
rep = MsgBox("Le texte est-il DITO ?", 4, Application.UserName)
If rep = 7 Then
[AW8].Select
Selection.ClearContents
Exit Sub
End If
Else
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW"
[AW8].Select
Selection.ClearContents
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(6, k) = "" Then Feuil2.Cells(6, k) = Target.Value:
Exit
For
Next
Target.Value = ""
End If
End If
Application.EnableEvents = True
End If

'macro plage 2

If Not Intersect(Target, Range("ba16:cc16")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?", 4,
Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 53 To 81 Step 2
If Feuil2.Cells(16, k) = "" Then Feuil2.Cells(16, k) > > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 3

If Not Intersect(Target,
Range("AF37,AF39,AF41,AF43,AF45,AF47,AF49,AF51,AF53,AF55")) Is Nothing
Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row + 1, Target.Column) = "NEW": Exit Sub
Else
Application.EnableEvents = False
For lig = 37 To 56 Step 2
If Feuil2.Cells(lig, 2) = "" Then Exit For
Next
If lig > 56 Then MsgBox "complet": Application.EnableEvents
= True: Exit Sub
mycol = Array(0, 2, 5, 20, 32, 35, 37, 39)
For k = 1 To 7
Feuil2.Cells(lig, mycol(k)) = Feuil1.Cells(Target.Row,
mycol(k))
If Feuil1.Range("AB" & Target.Row) = "" Then
Feuil1.Cells(Target.Row, mycol(k)) = ""
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If


'macro plage 4

If Not Intersect(Target, Range("I58:AI58")) Is Nothing Then
question = MsgBox("Est-ce un NEW ?", vbYesNo, Application.UserName)
If question = vbYes Then
Application.EnableEvents = False
question = MsgBox("La facturation se fait-elle sur 12 mois ?",
4, Application.UserName)
If question = 7 Then
Cells(Target.Row - 1, Target.Column) = "NEW": Exit Sub
Else
For k = 9 To 35 Step 2
If Feuil2.Cells(58, k) = "" Then Feuil2.Cells(58, k) > > Target.Value: Exit For
Next
Target.Value = ""
End If
Application.EnableEvents = True
End If
End If

'macro plage 5

If Not Intersect(Target,
Range("AB37,AB39,AB41,AB43,AB45,AB47,AB49,AB51,AB53,AB55")) Is Nothing
Then
If Left(Cells(Target.Row, Target.Column), 2) = "IL" Or
Left(Cells(Target.Row, Target.Column), 1) = "B" Or Left(Cells(Target.Row,
Target.Column), 2) = "1B" Or Left(Cells(Target.Row, Target.Column), 2) =
"2B"
Or Left(Cells(Target.Row, Target.Column), 1) = "L" Or
Left(Cells(Target.Row,
Target.Column), 1) = "J" Or Left(Cells(Target.Row, Target.Column), 2) =
"1J"
Or Left(Cells(Target.Row, Target.Column), 1) = "2J" Then
question = MsgBox("Est-ce un dito ?", vbYesNo,
Application.UserName)
If question = vbYes Then
Cells(Target.Row + 1, Target.Column) = "DITO 2006": Exit Sub
End If
End If
End If

End Sub









Publicité
Poster une réponse
Anonyme