Sujet Précédent Sujet Suivant

Code qui pose pb

Résolu
cs_julienb25 Messages postés 10 Date d'inscription mardi 15 juillet 2008 Statut Membre Dernière intervention 22 juillet 2008 - 15 juil. 2008 à 16:05
cs_julienb25 Messages postés 10 Date d'inscription mardi 15 juillet 2008 Statut Membre Dernière intervention 22 juillet 2008 - 22 juil. 2008 à 11:31
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

Réponse 1 / 8
cs_julienb25 Messages postés 10 Date d'inscription mardi 15 juillet 2008 Statut Membre Dernière intervention 22 juillet 2008
22 juil. 2008 à 11:31
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
3
Réponse 2 / 8
cs_julienb25 Messages postés 10 Date d'inscription mardi 15 juillet 2008 Statut Membre Dernière intervention 22 juillet 2008
15 juil. 2008 à 16:07
c'est au bon endroit?
0
Réponse 3 / 8
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
15 juil. 2008 à 17:12
bonne section => NON
déplacé de VB.NET vers VBA

si tu valides ta réponde, personne ne répondra
post dévalidé
0
Réponse 4 / 8
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
15 juil. 2008 à 19:19
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
17 juil. 2008 à 00:58
   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
0
Réponse 6 / 8
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
17 juil. 2008 à 06:35
Arf oui, bien vu MPi

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
0
Réponse 7 / 8
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
17 juil. 2008 à 10:28
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
0
Réponse 8 / 8
cs_julienb25 Messages postés 10 Date d'inscription mardi 15 juillet 2008 Statut Membre Dernière intervention 22 juillet 2008
21 juil. 2008 à 09:08
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
0

Discussions similaires

[D7] Impression code-barres sur une imprimante d'étiquettes
cs_nitrique -
cs_nitrique -

15 réponses
Algorithme de vérification RIB (24 chiffres / maroc)
aedc -
ucfoutu -

5 réponses
Générateur de codes de recharge
cs_kdidier -
ucfoutu -

6 réponses
Les flèches en ASCII
mage_des_enfers -
magic_Nono -

25 réponses
Code barre datamatrix
cs_yves29 -
Whismeril -

21 réponses
Rejoignez-nous