Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Pb execution macro evenementielle

1 réponse
Avatar
SD
Bonjour,
J'ai cr=E9e une macro evenementielle sous xl2000 mais elle ne s'=E9xecute
pas.
Normalement, elle devrait s'=E9x=E9cut=E9e avec le changement de la cellule
D4...
Le but =E9tant d'obtenir dans la colC une liste d=E9roulante associ=E9e =E0=
la
valeur de D4(variable)

Je ne vois pas ou est le pb, est-ce quelqu'un peut m'eclairer ?

La macro en question:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim col As Long
Dim row As Long
Dim nbRow As Long
Dim wk As Worksheet
Dim Deb As Integer
Dim Atelier As Integer

col =3D Target.Column
row =3D Target.row

If Target.Address =3D "$D$4" And [$D$4] <> "" Then

Set wk =3D Target.Worksheet
Atelier =3D Cells(1, 1).Value


If Application.WorksheetFunction.IsNumber(wk.Cells(1, 1)) Then
Deb =3D 8
nbRow =3D Worksheets("Config").Cells(5, Atelier)

With wk.Range("C" & row).Validation
.Delete
.Add Type:=3DxlValidateList,
AlertStyle:=3DxlValidAlertStop, Operator:=3DxlBetween, _
Formula1:=3D"=3D" & wk.Range(wk.Cells(Deb,
Atelier), wk.Cells(nbRow + 7, Atelier)).Address()
.IgnoreBlank =3D True
.InCellDropdown =3D True
.InputTitle =3D ""
.ErrorTitle =3D ""
.InputMessage =3D ""
.ErrorMessage =3D ""
.ShowInput =3D True
.ShowError =3D True
End With
Else
wk.Range("C" & row).Validation.Delete

End If
End If
End Sub

MErci par avance
SD

1 réponse

Avatar
Youky
Salut SD,
With wk.Range("C" & row).Validation ......row renvoie 4
à voir si row ou Nbrow
Sinon en fenêtre exécution copie ceci ..place le curseur à la fin et presse
Enter
application.EnableEvents=True
Ceci à pour but de rendre actif les événements.
Youky

"SD" a écrit dans le message de news:

Bonjour,
J'ai crée une macro evenementielle sous xl2000 mais elle ne s'éxecute
pas.
Normalement, elle devrait s'éxécutée avec le changement de la cellule
D4...
Le but étant d'obtenir dans la colC une liste déroulante associée à la
valeur de D4(variable)

Je ne vois pas ou est le pb, est-ce quelqu'un peut m'eclairer ?

La macro en question:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim col As Long
Dim row As Long
Dim nbRow As Long
Dim wk As Worksheet
Dim Deb As Integer
Dim Atelier As Integer

col = Target.Column
row = Target.row

If Target.Address = "$D$4" And [$D$4] <> "" Then

Set wk = Target.Worksheet
Atelier = Cells(1, 1).Value


If Application.WorksheetFunction.IsNumber(wk.Cells(1, 1)) Then
Deb = 8
nbRow = Worksheets("Config").Cells(5, Atelier)

With wk.Range("C" & row).Validation
.Delete
.Add Type:=xlValidateList,
AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
Formula1:="=" & wk.Range(wk.Cells(Deb,
Atelier), wk.Cells(nbRow + 7, Atelier)).Address()
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
wk.Range("C" & row).Validation.Delete

End If
End If
End Sub

MErci par avance
SD