Empecher double saisie

gibtoul

XLDnaute Junior
Bonjour à Tous

j'ai récuperé le code suivant pour eviter d'avoir sur les colonnes AS et AT une double saisie sur les celllules d'une meme ligne.

Je souhaiterais appliquer cela à plusieurs autre colonne : C et F , X et Z. ...;

Après plusieurs tentatives sans succès je fais appel au forum pour m'aider !!

Merci

A bientot

Gibtoul







Code:
Private Sub Worksheet_Change(ByVal zz As Range)
If Intersect(zz, Range("AS80:AT633")) Is Nothing Then Exit Sub
y = zz.Row
If Application.CountA(Range("AS" & y & ":AT" & y)) > 1 Then
Application.EnableEvents = False
MsgBox "Attention double saisie !!": zz = ""
Application.EnableEvents = True
End If
End Sub
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

bonjour Si...

Je te remercie pour l'aide apportée , cela fonctionne parfaitement
pour l'adapter à mon projet global et si je souhaite le modifié pour d'autre usage. J'ai identifié quelque points mais il m'en manque

Case : correspond au n° de colonne
Case 3: B = R(1, 18) : 18 = nombre de colonne entre Case 3 vers Case 20 (y compris 3 et20)
Case 20: B = R(1, -16) = "": o = IIf(C > R.Column, 0, 2) : -16 = = nombre de colonne entre Case 20 vers Case 3

Je ne vois pas comment faire pour parametrer :
le nombre de ligne : dans l'exemple entre les lignes 3 à 10
Si je veux aller jusqu'à la ligne 15 , je dois intervenir sur quel parametre

Si je veux rajouter la fonction sur la case 55 et 56 , j'ai rajouter ces lignes sans succès:

Case 55: B = R(1, 2) = "": o = IIf(C > R.Column, 0, 2)
Case 56: B = R(1, 0) = "": o = IIf(C > R.Column, 0, 2


A bientot

gibtoul
 

Si...

XLDnaute Barbatruc
Re : Empecher double saisie

salut

tout dépend de la plage d'action que j'ai nommée P :
dans If R.Count = 1 And Not Intersect(R, Range("P")) Is Nothing Then
la plage concernée P est définie dans Formules, Gestionnaire de noms
(sélection de chaque morceau en gardant la touche Ctrl appuyée)

pour les décalages
Select Case R.Column selon le numéro de la colonne sélectionnée ou active
3 pour C, 20 pour T, 45 pour As et 46 pour AT

cas C : la variable B est mise à vrai si la cellule décalée de 18 colonnes à droite est vide
C D E ... T
1 2 3 ... 18
cas T : la variable B est mise à vrai si la cellule décalée de 16 colonnes à gauche (-) est vide
C ... R S T
-16 … -1 0 1

o = IIf(C > R.Column, 0, 2) : le décalage o de 1 colonne vers la gauche (0) ou de 2 colonnes vers la droite (2) dépend de la position précédente du curseur
 

Dranreb

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour.
Je m'aperçois que la protection que j'avais mi dans la Worksheet_Activate ne marchait pas pour une raison que je ne comprends pas. En effet je ne spécifiais pas Contents, mais l'aide indiquait pourtant que True était assumé. Enfin j'ai utilisé l'enregistreur pour la refaire et étoffé un peu le code. Ça donne ça :
VB:
Option Explicit

Private Sub Worksheet_Activate()
Dim L As Long, I As Long
Me.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, UserInterfaceOnly:=True, _
   AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
   AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingRows:=True, _
   AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Me.EnableSelection = xlUnlockedCells
For L = 3 To 10
   For I = 0 To 3
      Verrou Me.Cells(L, Array("C", "T", "V", "W")(I)), _
             Me.Cells(L, Array("T", "C", "W", "V")(I))
      Next I
   Next L
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long, LAutre As Range
If Target.Count <> 1 Then Exit Sub
If Intersect(Me.[3:10], Target) Is Nothing Then Exit Sub
For I = 0 To 3
   If Not Intersect(Me.Columns(Array("C", "T", "V", "W")(I)), Target) Is Nothing Then
      Set LAutre = Intersect(Me.Columns(Array("T", "C", "W", "V")(I)), Target.EntireRow)
      Verrou Target, LAutre: Verrou LAutre, Target
      Exit Sub: End If
   Next I
End Sub

Private Sub Verrou(ByVal Cellule As Range, ByVal LAutre As Range)
If IsEmpty(LAutre.Value) Then
   Cellule.Interior.Color = &H80FFFF
   Cellule.Locked = False
ElseIf IsEmpty(Cellule.Value) Then
   Cellule.Interior.Color = &HC0C0C0
   Cellule.Locked = True
Else
   Cellule.Interior.Color = &H4040FF
   Cellule.Locked = False
   End If
End Sub
 

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof