Code qui pose pb [Résolu]

Signaler
Messages postés
10
Date d'inscription
mardi 15 juillet 2008
Statut
Membre
Dernière intervention
22 juillet 2008
-
Messages postés
10
Date d'inscription
mardi 15 juillet 2008
Statut
Membre
Dernière intervention
22 juillet 2008
-
re bonjour,

j'ai a nouveau un bout de code qui pose problème je ne connais pas la syntaxe exacte... le pb est en rouge
je voudrais qu'il ne reste qu'une seule valeur par ligne pour les colone E à I...


en gros je voudrais que les cellules de la ligne comprise entre les colonnes E et I soient supprimés sauf la cellules ou je veux la valeur...

voici le code que j'ai dans sa totalité:


 



Option Explicit



Const s_Refusee = "Refusée"
Const s_Attente = "Mise en attente"
Const s_Rien = ""
Const i_ColumnEtat = 2
Const i_FirstColumn1 = 5
Const i_LastColumn1 = 9
Const i_FirstColumn2 = 10
Const i_LastColumn2 = 13
Const i_column1 = 5
Const i_column2 = 6
Const i_column3 = 7
Const i_column4 = 8
Const i_column5 = 9



Dim s_Formula, s_Operator, s_Type, i, s_Row, a, b, c, d, e
Dim b_DeleteValue As Boolean
--------------------------------------------------------------------------------------------------------------



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
    If Target.Column = i_ColumnEtat Then
        ChangeValidation (Target.Row)
   
    ElseIf Target.Column = i_column1 Then
        Case1 (Target.Row)
       
    ElseIf Target.Column = i_column2 Then
        Case2 (Target.Row)
       
    ElseIf Target.Column = i_column3 Then
        Case3 (Target.Row)
       
    ElseIf Target.Column = i_column4 Then
        Case4 (Target.Row)
       
    ElseIf Target.Column = i_column5 Then
        Case5 (Target.Row)
    End If
   
End Sub



--------------------------------------------------------------------------------------------------------------------
Function ChangeValidation(s_Row As Integer)



    Application.ScreenUpdating = False    If Cells(s_Row, i_ColumnEtat).Value s_Refusee Or Cells(s_Row, i_ColumnEtat).Value s_Attente Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    Else
        s_Formula = "1"
        s_Operator = xlEqual
        s_Type = xlValidateList
        b_DeleteValue = False
    End If
   
    For i = i_FirstColumn1 To i_LastColumn1
        With Cells(s_Row, i).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With        If b_DeleteValue True Then Cells(s_Row, i).Value ""
    Next
        If Cells(s_Row, i_ColumnEtat).Value s_Refusee Or Cells(s_Row, i_ColumnEtat).Value s_Attente Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
   
    Else
        s_Formula = "x"
        s_Operator = xlEqual
        s_Type = xlValidateList
        b_DeleteValue = False
    End If
   
    For i = i_FirstColumn2 To i_LastColumn2
        With Cells(s_Row, i).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With        If b_DeleteValue True Then Cells(s_Row, i).Value ""
    Next
    Application.ScreenUpdating = True
End Function



---------------------------------------------------------------------------------------------------------------------



Function Case1(s_Row As Integer)



Application.ScreenUpdating = False



    If Cells(s_Row, i_column1).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For a = i_column2 To i_LastColumn1
    With Cells(s_Row, a).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
    End With    If b_DeleteValue True Then Cells(s_Row, a).Value ""
Next a
End Function
---------------------------------------------------------------------------------------------------------------------



Function Case2(s_Row As Integer)



Application.ScreenUpdating = False



    If Cells(s_Row, i_column2).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For b = i_FirstColumn1 To i_LastColumn1
     If b <> i_column2 Then
         With Cells(s_Row, b).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
Next b
   If b_DeleteValue = True Then        Cells(s_Row, i_column1).Value "" and Cells(s_Row, i_column3).Value "" and Cells(s_Row, i_column4).Value = "" and Cells(s_Row, i_column5).Value = ""  
         
End Function
-----------------------------------------------------------------------------------------------------------------------



Function Case3(s_Row As Integer)



Application.ScreenUpdating = False



    If Cells(s_Row, i_column3).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For c = i_FirstColumn1 To i_LastColumn1
     If c <> i_column3 Then
         With Cells(s_Row, c).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If   ' If b_DeleteValue True Then Cells(s_Row, i).Value ""
Next c
End Function
---------------------------------------------------------------------------------------------------------------------------



Function Case4(s_Row As Integer)



Application.ScreenUpdating = False



    If Cells(s_Row, i_column4).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For d = i_FirstColumn1 To i_LastColumn1
    If d <> i_column4 Then
        With Cells(s_Row, d).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If    'If b_DeleteValue True Then Cells(s_Row, i).Value ""
Next d
End Function



----------------------------------------------------------------------------------------------------------------------------
Function Case5(s_Row As Integer)



Application.ScreenUpdating = False



    If Cells(s_Row, i_column5).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For e = i_FirstColumn1 To i_column4
        With Cells(s_Row, e).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
    End With    'If b_DeleteValue True Then Cells(s_Row, i).Value ""
Next e
End Function

8 réponses

Messages postés
10
Date d'inscription
mardi 15 juillet 2008
Statut
Membre
Dernière intervention
22 juillet 2008

J'ai trouvé ma solution...je l'ai placé directement sous le premier If

comme ceci

---------------------------------------------------------------------------------------------------------------------------
Case4(s_Row As Integer)
Application.ScreenUpdating = False

    If Cells(s_Row, i_column4).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        Cells(s_Row, i_column1).Value = ""
        Cells(s_Row, i_column2).Value = ""
        Cells(s_Row, i_column3).Value = ""
        Cells(s_Row, i_column5).Value = ""

        
    End If
For d = i_FirstColumn1 To i_LastColumn1
    If d <> i_column4 Then
        With Cells(s_Row, d).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
Next d
   
End Function
Messages postés
10
Date d'inscription
mardi 15 juillet 2008
Statut
Membre
Dernière intervention
22 juillet 2008

c'est au bon endroit?
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
bonne section => NON
déplacé de VB.NET vers VBA

si tu valides ta réponde, personne ne répondra
post dévalidé
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
salut,

l'idéal ce serait que tu mettes un point d'arrêt sur la ligne If b_DeleteValue = True Then
ensuite, tu vérifie tes valeurs en mode pas à pas (F8)

Cela étant le mieux afin de vérifier tes valeurs (en passant la souris sur tes variables lors de l'éxecution de la-dite ligne)

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
   If b_DeleteValue = True Then 
       Cells(s_Row,
i_column1).Value = ""
       Cells(s_Row, i_column3).Value = ""

       Cells(s_Row, i_column4).Value = ""
       Cells(s_Row,
i_column5).Value = "" 
  End If

Tu ne peux pas mettre de AND de cette façon.
Dans la condition If, ça va , mais pas dans l'action à effectuer.

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Arf oui, bien vu MPi

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Autre détail...
Tu utilises des "Function" qui ne retournent rien (leur raison d'être).
Aussi bien utiliser des "Sub" qui sont là pour ça.

Salut Mortalino,
Comme il n'y avait pas de End If, au premier coup d'oeil, j'ai aussi pensé que les AND faisaient partie du If...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
Messages postés
10
Date d'inscription
mardi 15 juillet 2008
Statut
Membre
Dernière intervention
22 juillet 2008

Bonjour à tous,
Tout d'abord merci pour votre aide...
J'ai essayé d'appliquer ce que vous m'avez dit mais il reste un problème:
j'ai l'impression qu'il tourne en rond et n'arrive pas a s'arreter .
Quand je met debogage il revient sur les lignes IgnoreBlank = True
voila ce que j'ai remplacé:


---------------------------------------------------------------------------------------------------------------------------
Function Case2(s_Row As Integer)


Application.ScreenUpdating = False


    If Cells(s_Row, i_column2).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For b = i_FirstColumn1 To i_LastColumn1
     If b <> i_column2 Then
         With Cells(s_Row, b).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
Next b
    If b_DeleteValue = True Then
       Cells(s_Row, i_column1).Value = ""
       Cells(s_Row, i_column3).Value = ""
       Cells(s_Row, i_column4).Value = ""
       Cells(s_Row, i_column5).Value = ""
  End If


----------------------------------------------------------------------------------------------------------------------------    
         
End Function


Function Case3(s_Row As Integer)


Application.ScreenUpdating = False


    If Cells(s_Row, i_column3).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For c = i_FirstColumn1 To i_LastColumn1
     If c <> i_column3 Then
         With Cells(s_Row, c).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = False
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
Next c
     If b_DeleteValue = True Then
       Cells(s_Row, i_column1).Value = ""
       Cells(s_Row, i_column2).Value = ""
       Cells(s_Row, i_column4).Value = ""
       Cells(s_Row, i_column5).Value = ""
  End If




End Function




----------------------------------------------------------------------------------------------------------------------------Function Case4(s_Row As Integer)


Application.ScreenUpdating = False


    If Cells(s_Row, i_column4).Value = 1 Then
        s_Formula = """"""
        s_Operator = xlBetween
        s_Type = xlValidateCustom
        b_DeleteValue = True
       
    End If
For d = i_FirstColumn1 To i_LastColumn1
    If d <> i_column4 Then
        With Cells(s_Row, d).Validation
            .Delete
            .Add Type:=s_Type, AlertStyle:=xlValidAlertStop, Operator:=s_Operator, Formula1:=s_Formula
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
Next d
    If b_DeleteValue = True Then
       Cells(s_Row, i_column1).Value = ""
       Cells(s_Row, i_column2).Value = ""
       Cells(s_Row, i_column3).Value = ""
       Cells(s_Row, i_column5).Value = ""
  End If




End Function