Sujet Précédent Sujet Suivant

Erreur constitution de liste de choix en VBA

marmotte78 Messages postés 8 Date d'inscription jeudi 30 novembre 2006 Statut Membre Dernière intervention 10 mai 2007 - 10 mai 2007 à 09:32
marmotte78 Messages postés 8 Date d'inscription jeudi 30 novembre 2006 Statut Membre Dernière intervention 10 mai 2007 - 10 mai 2007 à 10:23
Bonjour a tous

J'ai un gros souci avec un petit bout de code, je vous explique :

Je souhaite charger une liste de choix dans la cellule (i,j) et l'application me retourne un message d'erreur lors de l'éxécution que je n'arrive pas à corriger.

"Erreur 1004 : Erreur definie par l'application ou par l'objet"

Toutes mes variables sont correctement renseignées.
Il me semble que le pb vient du "validation".

Merci d'avance pour votre aide

Voici l'extrait de code (le pb est en rouge):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)



i = Selection.Row
j = Selection.Column




choix = Cells(i, j).Value
 
If i > 2 Then
     
     
   If j = 10 Then
  
   Set plage = Cells(i, j - 1).Find("rotation", lookat:=xlPart)
  
   If Not plage Is Nothing Then
   Set plage2 = Rows(1).Find(Cells(2, j).Value, lookat:=xlWhole)
  
   a = plage2.Column
   Set plage2 = Rows(1).FindNext(Cells(1, plage2.Column))
   b = plage2.Column
   k = 2
   Do
   k = k + 1
   Loop Until Cells(k, b).Value = ""
  
   Liste2 = Range(Cells(3, b), Cells(k - 1, b)).Address
   
    With Cells(i, j).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & Liste2
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
     End With
    
     Cells(i, j).Font.Bold = False
     Cells(i, j).Font.Size = 10
    
     Else
    
     With Cells(i, j).Validation
      .Delete
      .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
      :=xlBetween
      .IgnoreBlank = True
      .InCellDropdown = True
      .InputTitle = ""
      .ErrorTitle = ""
      .InputMessage = ""
      .ErrorMessage = ""
      .ShowInput = True
      .ShowError = True
    End With
   
    Cells(i, j).Value = "N/A"
   
    End If
 
   ElseIf j >= 12 And j <= 37 Then
     
      Set plage = Rows(2).Find("Code", lookat:=xlWhole)
       
        If Not plage Is Nothing Then
       
            c = plage.Column
           
            If Cells(i, c).Value <> "" Then
           
                Set plage = Range(Cells(1, 53), Cells(2, 200)).Find(Cells(i, c).Value, lookat:=xlWhole)
               
                If Not plage Is Nothing Then
               
                    a = plage.Column
                   
                    Set plage2 = Range(Cells(4, a + 2), Cells(4, a + 1 + Cells(1, a + 1).Value)).Find(Cells(2, j).Value, lookat:=xlWhole)
                   
                    If Not plage2 Is Nothing Then
                   
                        With Cells(i, j).Interior
                            .ColorIndex = xlNone
                        End With
                                               
                        b = plage2.Column
                        k = 5
                        l = 5
                        Range(Cells(5, a), Cells(50, a)).ClearContents
                        Do
                            Set plage3 = Range(Cells(5, a), Cells(l, a)).Find(Cells(k, b).Value, lookat:=xlWhole)
                            If plage3 Is Nothing Then
                                Cells(l, a).Value = Cells(k, b).Value
                                l = l + 1
                            End If
                            k = k + 1
                           
                        Loop Until Cells(k, b).Value = ""
                       
                        liste = Range(Cells(5, a), Cells(l - 1, a)).Address
                       
                        With Cells(i, j).Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                            xlBetween, Formula1:="=" & liste
                            .IgnoreBlank = True
                            .InCellDropdown = True
                            .InputTitle = ""
                            .ErrorTitle = ""
                            .InputMessage = ""
                            .ErrorMessage = ""
                            .ShowInput = True
                            .ShowError = True
                        End With
                   
                    Else
                       
                        With Cells(i, j).Validation
                          .Delete
                          .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                          :=xlBetween
                          .IgnoreBlank = True
                          .InCellDropdown = True
                          .InputTitle = ""
                          .ErrorTitle = ""
                          .InputMessage = ""
                          .ErrorMessage = ""
                          .ShowInput = True
                          .ShowError = True
                        End With
                       
                        With Cells(i, j).Interior
                            .ColorIndex = 15
                            .Pattern = xlSolid
                        End With
                       
                    End If
                End If
            Else
            With Cells(i, j).Validation
                          .Delete
                          .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                          :=xlBetween
                          .IgnoreBlank = True
                          .InCellDropdown = True
                          .InputTitle = ""
                          .ErrorTitle = ""
                          .InputMessage = ""
                          .ErrorMessage = ""
                          .ShowInput = True
                          .ShowError = True
                        End With
                       
                        Cells(i, j).ClearContents
                        With Cells(i, j).Interior
                            .ColorIndex = 15
                            .Pattern = xlSolid
                        End With
            End If
        Else
           
            Message = MsgBox("I cannot find the column Code", vbExclamation)
        End If
    End If
End If
    
End Sub

4 réponses

Réponse 1 / 4
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
10 mai 2007 à 09:50
Salut,
j'essaie de reproduire ton problème. j'arrive a avoir ton erreur lorsque je selectionne des valeurs dans deux colonnes.
SI je sélectionne des valeurs dans une seule colonne je n'ai pas de problème et j'obtiens une liste déroulante avec les valeurs

@+: Ju£i?n
Pensez: Réponse acceptée
0
Réponse 2 / 4
marmotte78 Messages postés 8 Date d'inscription jeudi 30 novembre 2006 Statut Membre Dernière intervention 10 mai 2007
10 mai 2007 à 10:05
ici j'ai le message d'erreur meme dans une colonne unique : liste="=" & "$EZ$5:$EZ$7"
0
Réponse 3 / 4
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
10 mai 2007 à 10:10
Salut,
est ce qu'il y a des cellules vides?

@+: Ju£i?n
Pensez: Réponse acceptée
0
Réponse 4 / 4
marmotte78 Messages postés 8 Date d'inscription jeudi 30 novembre 2006 Statut Membre Dernière intervention 10 mai 2007
10 mai 2007 à 10:23
d'apres le fonctionnement du code il n'est pas possible d'avoir des cellules vides.
Une liste de valeur dans excel est contituée à chaque à chaque constitution de liste de choix
0

Discussions similaires

Erreur d’exécution 424 : objet requis
luciol8 -
Marion8316 -

7 réponses
Erreur 424 Objet requis Macro Excel
Gagou_c -
chouchouk8917 -

4 réponses
Erreur 424 "Objet requis"
cs_wow59 -
wow59 -

2 réponses
Message d'erreur 424: objet requis
dyjatou92 -
ucfoutu -

7 réponses
Macro envoi de mail : "Erreur 424 : Objet requis"
TITILALA -
cs_Le Pivert -

1 réponse
Rejoignez-nous