Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Modifier macro pour mettre doublons en Rouge

Modifier macro pour mettre doublons en Rouge

10 réponses
Avatar
Christophe Joly
Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la meme
ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je réponds
oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et que ma
saisie est conservée, la police du texte de cette cellule soit par exemple
en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row, UsedRange.SpecialCells(xlCellTypeLastCell).Column))
Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
ru-th
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la meme
ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et que
ma

saisie est conservée, la police du texte de cette cellule soit par exemple
en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row, UsedRange.SpecialCells(xlCellTypeLastCell).Column))
Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub




Avatar
Christophe Joly
Bonsoir Thierry:

Comme quoi il n'y a pas besoin de savoir lire pour ecrire des macros :-)

MERCI.

Christophe
"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et que
ma

saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub








Avatar
Christophe Joly
Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après qu'elle est
été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras meme
lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et que
ma

saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub








Avatar
michdenis
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de news:
Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après qu'elle est
été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras meme
lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et que
ma

saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub








Avatar
Christophe Joly
Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la couleur
de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur texte
noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et en
gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après qu'elle
est

été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras
meme

lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et
que



ma
saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub













Avatar
michdenis
Bonjour Christophe,

Tu as essayé quelque chose dans le genre :

With Target
With .Font
.ColorIndex = False
.Bold = False
End With
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With


Salutations!


"Christophe Joly" a écrit dans le message de news:
Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la couleur
de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur texte
noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et en
gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après qu'elle
est

été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras
meme

lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et
que



ma
saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub













Avatar
Christophe Joly
Ca fonctionne comme dans un reve.
Sinceres remerciements.
Christophe

"michdenis" a écrit dans le message de
news:
Bonjour Christophe,

Tu as essayé quelque chose dans le genre :

With Target
With .Font
.ColorIndex = False
.Bold = False
End With
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With


Salutations!


"Christophe Joly" a écrit dans le message de
news:

Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la
couleur

de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur texte
noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et en
gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après qu'elle
est

été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras
meme

lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de news:

Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans la
meme


ligne ou dans la meme colonne lors de la saisie d'une donnée. Si je
réponds

oui ma saisie est effacée et si je reponds non elle est conservée.
J'aimerais modifier ces macros pour qu' en plus si je réponds non et
que



ma
saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True,
_




AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True,
_




AllowFormattingRows:=True
End Sub


















Avatar
Christophe Joly
Rebonsoir:

Malheureusement le reve fut de courte durée :-(
Avec tes dernieres instructions la cellule reste vide quelque soit la valeur
selectionnée dans mon menu deroulant. Si j'enlève l'instruction
ClearContents
Application.EnableEvents = True
End With
et laisse uniquement

With Target
With .Font
.ColorIndex = False
.Bold = False
End With

le texte selectionné reste en rouge meme lorsqu'il y a plus doublons.Je ne
comprend pas pourquoi le format de la police de la cellule ne revient pas à
son etat initial c.a.d. noir sans gras et reste rouge gras meme lorsqu' il
n'y a plus doublons.

Merci.

Christophe

"Christophe Joly" a écrit dans le message de
news:
Ca fonctionne comme dans un reve.
Sinceres remerciements.
Christophe

"michdenis" a écrit dans le message de
news:
Bonjour Christophe,

Tu as essayé quelque chose dans le genre :

With Target
With .Font
.ColorIndex = False
.Bold = False
End With
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With


Salutations!


"Christophe Joly" a écrit dans le message de
news:

Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la
couleur

de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur texte
noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et en
gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après
qu'elle



est
été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras
meme

lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de
news:





Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans
la





meme
ligne ou dans la meme colonne lors de la saisie d'une donnée. Si
je





réponds
oui ma saisie est effacée et si je reponds non elle est
conservée.





J'aimerais modifier ces macros pour qu' en plus si je réponds non
et





que
ma
saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub






















Avatar
michdenis
Bonsoir Christophe,


Si tu ne présente pas ce que tu veux dans son contexte global, il ne faut pas te surprendre que tu n'obtiennes de réponse
adaptée à ta problématique... !


Salutations!


"Christophe Joly" a écrit dans le message de news:%
Rebonsoir:

Malheureusement le reve fut de courte durée :-(
Avec tes dernieres instructions la cellule reste vide quelque soit la valeur
selectionnée dans mon menu deroulant. Si j'enlève l'instruction
ClearContents
Application.EnableEvents = True
End With
et laisse uniquement

With Target
With .Font
.ColorIndex = False
.Bold = False
End With

le texte selectionné reste en rouge meme lorsqu'il y a plus doublons.Je ne
comprend pas pourquoi le format de la police de la cellule ne revient pas à
son etat initial c.a.d. noir sans gras et reste rouge gras meme lorsqu' il
n'y a plus doublons.

Merci.

Christophe

"Christophe Joly" a écrit dans le message de
news:
Ca fonctionne comme dans un reve.
Sinceres remerciements.
Christophe

"michdenis" a écrit dans le message de
news:
Bonjour Christophe,

Tu as essayé quelque chose dans le genre :

With Target
With .Font
.ColorIndex = False
.Bold = False
End With
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With


Salutations!


"Christophe Joly" a écrit dans le message de
news:

Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la
couleur

de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur texte
noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et en
gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après
qu'elle



est
été convertie en "Rouge et Gras". La cellule conserve ce format et les
entrées suivantes dans la cellule sont elles aussi en Rouge et en Gras
meme

lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de
news:





Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons dans
la





meme
ligne ou dans la meme colonne lors de la saisie d'une donnée. Si
je





réponds
oui ma saisie est effacée et si je reponds non elle est
conservée.





J'aimerais modifier ces macros pour qu' en plus si je réponds non
et





que
ma
saisie est conservée, la police du texte de cette cellule soit par
exemple


en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , , False)
If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub






















Avatar
Christophe Joly
Denis:

Désolé de ne pas avoir été complet et assez explicite mais je ne maitrise
pas le sujet si tu vois ce que je veux dire... J'ai compris mon erreur. Il y
a en fait une autre private sub qui recherche les doublons et que les
instructions de reinitilisation du format de la target doivent figurer à ce
niveau.

Merci.

Christophe
"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Si tu ne présente pas ce que tu veux dans son contexte global, il ne faut
pas te surprendre que tu n'obtiennes de réponse

adaptée à ta problématique... !


Salutations!


"Christophe Joly" a écrit dans le message de
news:%

Rebonsoir:

Malheureusement le reve fut de courte durée :-(
Avec tes dernieres instructions la cellule reste vide quelque soit la
valeur

selectionnée dans mon menu deroulant. Si j'enlève l'instruction
ClearContents
Application.EnableEvents = True
End With
et laisse uniquement

With Target
With .Font
.ColorIndex = False
.Bold = False
End With

le texte selectionné reste en rouge meme lorsqu'il y a plus doublons.Je ne
comprend pas pourquoi le format de la police de la cellule ne revient pas
à

son etat initial c.a.d. noir sans gras et reste rouge gras meme lorsqu' il
n'y a plus doublons.

Merci.

Christophe

"Christophe Joly" a écrit dans le message de
news:
Ca fonctionne comme dans un reve.
Sinceres remerciements.
Christophe

"michdenis" a écrit dans le message de
news:
Bonjour Christophe,

Tu as essayé quelque chose dans le genre :

With Target
With .Font
.ColorIndex = False
.Bold = False
End With
Application.EnableEvents = False
.ClearContents
Application.EnableEvents = True
End With


Salutations!


"Christophe Joly" a écrit dans le message de
news:

Bonsoir Denis:

Merci. Si j'utilise Target.ClearFormats je perds malheureusement la
couleur

de l'ombrage de la cellule.
J'ai pensé remettre la cellule en son état initial c.a.d. couleur
texte



noir et enlever le gras.
Pour cela j'ai ecrit
target.Font.ColorIndex = 1
target.Font.Bold = False
mais cela ne fonctionne pas. Le texte de la cellule reste en rouge et
en



gras meme lorqu'il n' y a plus de doublons. (voir macro complete
ci-dessous).

Quelle est mon erreur? Merci.

Christophe
-------------------------------------------
Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False

target.Font.ColorIndex = 1
target.Font.Bold = False

If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) & _
"Christophe is asking if you would you like to delete your current
entry

" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else
target.Font.ColorIndex = 3
target.Font.Bold = True

End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub


"michdenis" a écrit dans le message de
news:
Bonsoir Christophe,


Target.ClearContents 'Efface le contenu
Target.ClearFormats 'Efface le format
Target.Clear 'Efface tout (contenu + format)



Salutations!




"Christophe Joly" a écrit dans le message de
news:

Thierry:

J'ai un petit problème. Si je décide d'effacer ma saisie après
qu'elle



est
été convertie en "Rouge et Gras". La cellule conserve ce format et
les




entrées suivantes dans la cellule sont elles aussi en Rouge et en
Gras




meme
lorsqu'il n'y a pas doublons.

Est-ce que tu aurais une solution? Meme sans lire...

Christophe

"ru-th" a écrit dans le message de
news:%
Salut

pas le courage de lire la macro :-((
mais, a priori
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) &
_






"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
else

target.Font.ColorIndex = 3
target.Font.Bold = True
End If



--
a+
rural thierry
Veaux et Broutards d'Anjou
Wicasa on kin nape yapi inahni yo (à l'essai)

"Christophe Joly" a écrit dans le message de
news:





Bonsoir à tous:

Les macros ci-dessous me permettent de signifier un doublons
dans






la
meme
ligne ou dans la meme colonne lors de la saisie d'une donnée. Si
je





réponds
oui ma saisie est effacée et si je reponds non elle est
conservée.





J'aimerais modifier ces macros pour qu' en plus si je réponds
non






et
que
ma
saisie est conservée, la police du texte de cette cellule soit
par






exemple
en Rouge et en Gras. Merci d'avance pour votre aide.

Christophe.
----------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
Dim rng As Range, Srng As Range
On Error GoTo DealWithIt
Set rng = UsedRange.Columns(Target.Column)
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , ,
False)






If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
Set rng = Range(Cells(Target.Row, 1), _
Cells(Target.Row,
UsedRange.SpecialCells(xlCellTypeLastCell).Column))


Debug.Print rng.Address
Set Srng = rng.Find(Target, Target, xlValues, xlWhole, , ,
False)






If Not Srng Is Nothing And _
Srng.Address <> Target.Address And _
Trim(Target) <> "" Then FoundDuplicate Target, Srng
DealWithIt:
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub

Private Sub FoundDuplicate(Target As Range, Frng As Range)
ActiveSheet.Unprotect
Application.EnableEvents = False
If MsgBox("Duplicate entry found in " & Frng.Address & Chr(13) &
_






"Christophe is asking if you would you like to delete your
current




entry
" & _
Target & "?", vbYesNo) = vbYes Then
Target.ClearContents
Target.Select
End If
Application.EnableEvents = True
Sheets("Country Appointments").Protect DrawingObjects:=True,
Contents:=True,

Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True,





_
AllowFormattingRows:=True
End Sub