Adaptation d'un code VBA d'une seule plage à plusieurs plages de cellules

Bonjour.
La macro va traiter les plages Plage, Plage1 et Plage2. Tu modifies
selon tes besoins.
J'ai ajouté :
Set Plages = Union(Range("Plage"), Range("Plage1"), Range("Plage2"))
If Intersect(Target, Plages) Is Nothing Then Exit Sub

à la macro :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Set Plages = Union(Range("Plage"), Range("Plage1"), Range("Plage2"))
If Intersect(Target, Plages) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
Cancel = True
End Sub

Bonjour à vous tous,

j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
pour qu'il fonctionne sur plusieurs plages différentes dans la même
feuille.
En renommant mes plages et en le recopiant le code, cela ne fonctionne
pas.

Merci de votre coup de main.

A bientôt

Guido

--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
Cancel = True
End Sub

Bonjour,
'--------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set plage = [plage1,plage2,plage3] ' '****A adapter*****
If Intersect(Target, plage) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorIndex = 0
If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorIndex = 0
Cancel = True
End Sub
'----------------
Voir ici
http://www.cijoint.fr/cjlink.php?file=cj201002/cijlO2Z50Y.xls

--
Salutations
JJ


"Guido" <guido.b29@gmail.com> a écrit dans le message de news:
600615d8-4878-4085-80c0-db1291bc5019@m16g2000yqc.googlegroups.com...
Bonjour à vous tous,

j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
pour qu'il fonctionne sur plusieurs plages différentes dans la même
feuille.
En renommant mes plages et en le recopiant le code, cela ne fonctionne
pas.

Merci de votre coup de main.

A bientôt

Guido

--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
Cancel = True
End Sub

Bonsoir à vous tous,

merci de votre réponse.

Concernant l'utilisation de ces plages, il s'agit donc de pouvoir les
différencier avec mes croix de couleurs différentes.
Je me retrouverai donc avec 6 plages différentes et donc, 6 croix de
couleurs différentes. Mais dans ce cas, j'ai essayé de corriger If
intersect (plage 1 à 6), et j'ai également essayer de copier 5 fois le
If Intersect en nommant les plages de 1 à 6.

C'est pas top. cela me donne un message d'erreur et me demande de
corriger le code.

Vous auriez la solutions ?

Merci à vous

Guido


On 8 fév, 14:45, "Jacky" <Dup...@marcel.fr> wrote:

Bonjour,
'--------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set plage = [plage1,plage2,plage3] ' '****A adapter*****
If Intersect(Target, plage) Is Nothing Then Exit Sub
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 0
    End With
    If Target = "" Then Target = "X" Else: Target = ""
   If Not Intersect(Target, plage) Is Nothing Then Selection.Font.Col orIndex = 0
   If Not Intersect(Target, plage) Is Nothing Then Selection.Font.Col orIndex = 0
   Cancel = True
End Sub
'----------------
Voir icihttp://www.cijoint.fr/cjlink.php?file=cj201002/cijlO2Z50Y.xls

--
Salutations
JJ

"Guido" <guido....@gmail.com> a écrit dans le message de news:
600615d8-4878-4085-80c0-db1291bc5...@m16g2000yqc.googlegroups.com...
Bonjour à vous tous,

j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
pour qu'il fonctionne sur plusieurs plages différentes dans la même
feuille.
En renommant mes plages et en le recopiant le code, cela ne fonctionne
pas.

Merci de votre coup de main.

A bientôt

Guido

--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 0
    End With
    If Target = "" Then Target = "X" Else: Target = ""
   If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
   If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
   Cancel = True
End Sub

Bonsoir.
Essaie, en changeant les valeurs de la variable Couleur :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Not Intersect(Target, Range("Plage")) Is Nothing Then
Couleur = 3
ElseIf Not Intersect(Target, Range("Plage1")) Is Nothing Then
Couleur = 9
ElseIf Not Intersect(Target, Range("Plage2")) Is Nothing Then
Couleur = 0
Else
Exit Sub
End If
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = Couleur
End With
If Target = "" Then Target = "X" Else: Target = ""
Cancel = True
End Sub
Daniel

Bonsoir à vous tous,

merci de votre réponse.

Concernant l'utilisation de ces plages, il s'agit donc de pouvoir les
différencier avec mes croix de couleurs différentes.
Je me retrouverai donc avec 6 plages différentes et donc, 6 croix de
couleurs différentes. Mais dans ce cas, j'ai essayé de corriger If
intersect (plage 1 à 6), et j'ai également essayer de copier 5 fois le
If Intersect en nommant les plages de 1 à 6.

C'est pas top. cela me donne un message d'erreur et me demande de
corriger le code.

Vous auriez la solutions ?

Merci à vous

Guido


On 8 fév, 14:45, "Jacky" <Dup...@marcel.fr> wrote:

Bonjour,
'--------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean) Set plage = [plage1,plage2,plage3] ' '****A adapter*****
If Intersect(Target, plage) Is Nothing Then Exit Sub
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 0
    End With
    If Target = "" Then Target = "X" Else: Target = ""
   If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorIndex
= 0    If Not Intersect(Target, plage) Is Nothing Then
Selection.Font.ColorIndex = 0    Cancel = True
End Sub
'----------------
Voir icihttp://www.cijoint.fr/cjlink.php?file=cj201002/cijlO2Z50Y.xls

--
Salutations
JJ

"Guido" <guido....@gmail.com> a écrit dans le message de news:
600615d8-4878-4085-80c0-db1291bc5...@m16g2000yqc.googlegroups.com...
Bonjour à vous tous,

j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
pour qu'il fonctionne sur plusieurs plages différentes dans la même
feuille.
En renommant mes plages et en le recopiant le code, cela ne fonctionne
pas.

Merci de votre coup de main.

A bientôt

Guido

--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 0
    End With
    If Target = "" Then Target = "X" Else: Target = ""
   If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
   If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
   Cancel = True
End Sub

Re..
Autre méthode...
Voir ici
http://www.cijoint.fr/cjlink.php?file=cj201002/cijMx0h55m.xls

--
Salutations
JJ


"Guido" <guido.b29@gmail.com> a écrit dans le message de news:
4e378dc5-632e-4677-82af-bac106118ab9@m31g2000yqb.googlegroups.com...
Bonsoir à vous tous,

merci de votre réponse.

Concernant l'utilisation de ces plages, il s'agit donc de pouvoir les
différencier avec mes croix de couleurs différentes.
Je me retrouverai donc avec 6 plages différentes et donc, 6 croix de
couleurs différentes. Mais dans ce cas, j'ai essayé de corriger If
intersect (plage 1 à 6), et j'ai également essayer de copier 5 fois le
If Intersect en nommant les plages de 1 à 6.

C'est pas top. cela me donne un message d'erreur et me demande de
corriger le code.

Vous auriez la solutions ?

Merci à vous

Guido


On 8 fév, 14:45, "Jacky" <Dup...@marcel.fr> wrote:

Bonjour,
'--------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set plage = [plage1,plage2,plage3] ' '****A adapter*****
If Intersect(Target, plage) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorIndex = 0
If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorIndex = 0
Cancel = True
End Sub
'----------------
Voir icihttp://www.cijoint.fr/cjlink.php?file=cj201002/cijlO2Z50Y.xls

--
Salutations
JJ

"Guido" <guido....@gmail.com> a écrit dans le message de news:
600615d8-4878-4085-80c0-db1291bc5...@m16g2000yqc.googlegroups.com...
Bonjour à vous tous,

j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
pour qu'il fonctionne sur plusieurs plages différentes dans la même
feuille.
En renommant mes plages et en le recopiant le code, cela ne fonctionne
pas.

Merci de votre coup de main.

A bientôt

Guido

--------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 0
End With
If Target = "" Then Target = "X" Else: Target = ""
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
If Not Intersect(Target, Range("plage")) Is Nothing Then
Selection.Font.ColorIndex = 0
Cancel = True
End Sub

Merci Daniel,
Merci Jacky,

(Cri de joies, saut de joie, etc....)

C'est super.

Merci

Guido

On 8 fév, 23:24, "Jacky" <Dup...@marcel.fr> wrote:

Re..
Autre méthode...
Voir icihttp://www.cijoint.fr/cjlink.php?file=cj201002/cijMx0h55m.xls

--
Salutations
JJ

"Guido" <guido....@gmail.com> a écrit dans le message de news:
4e378dc5-632e-4677-82af-bac106118...@m31g2000yqb.googlegroups.com...
Bonsoir à vous tous,

merci de votre réponse.

Concernant l'utilisation de ces plages, il s'agit donc de pouvoir les
différencier avec mes croix de couleurs différentes.
Je me retrouverai donc avec 6 plages différentes et donc, 6 croix de
couleurs différentes. Mais dans ce cas, j'ai essayé de corriger If
intersect (plage 1 à 6), et j'ai également essayer de copier 5 fois l e
If Intersect en nommant les plages de 1 à 6.

C'est pas top. cela me donne un message d'erreur et me demande de
corriger le code.

Vous auriez la solutions ?

Merci à vous

Guido

On 8 fév, 14:45, "Jacky" <Dup...@marcel.fr> wrote:

> Bonjour,
> '--------------
> Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel A s Boolean)
> Set plage = [plage1,plage2,plage3] ' '****A adapter*****
> If Intersect(Target, plage) Is Nothing Then Exit Sub
> With Selection
> .HorizontalAlignment = xlCenter
> .VerticalAlignment = xlCenter
> .WrapText = False
> .Orientation = 0
> .AddIndent = False
> .IndentLevel = 0
> .ShrinkToFit = False
> .ReadingOrder = xlContext
> .MergeCells = False
> End With
> With Selection.Font
> .Name = "Arial"
> .FontStyle = "Gras"
> .Size = 12
> .Strikethrough = False
> .Superscript = False
> .Subscript = False
> .OutlineFont = False
> .Shadow = False
> .Underline = xlUnderlineStyleNone
> .ColorIndex = 0
> End With
> If Target = "" Then Target = "X" Else: Target = ""
> If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorInd ex = 0
> If Not Intersect(Target, plage) Is Nothing Then Selection.Font.ColorInd ex = 0
> Cancel = True
> End Sub
> '----------------
> Voir icihttp://www.cijoint.fr/cjlink.php?file=cj201002/cijlO2Z50Y.xls

> --
> Salutations
> JJ

> "Guido" <guido....@gmail.com> a écrit dans le message de news:
> 600615d8-4878-4085-80c0-db1291bc5...@m16g2000yqc.googlegroups.com...
> Bonjour à vous tous,

> j'ai reçu en son temps le code ci-dessous et je désirerai l'adapter
> pour qu'il fonctionne sur plusieurs plages différentes dans la même
> feuille.
> En renommant mes plages et en le recopiant le code, cela ne fonctionne
> pas.

> Merci de votre coup de main.

> A bientôt

> Guido

> --------------------------------------
> Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
> As Boolean)
> If Intersect(Target, Range("plage")) Is Nothing Then Exit Sub
> With Selection
> .HorizontalAlignment = xlCenter
> .VerticalAlignment = xlCenter
> .WrapText = False
> .Orientation = 0
> .AddIndent = False
> .IndentLevel = 0
> .ShrinkToFit = False
> .ReadingOrder = xlContext
> .MergeCells = False
> End With
> With Selection.Font
> .Name = "Arial"
> .FontStyle = "Gras"
> .Size = 12
> .Strikethrough = False
> .Superscript = False
> .Subscript = False
> .OutlineFont = False
> .Shadow = False
> .Underline = xlUnderlineStyleNone
> .ColorIndex = 0
> End With
> If Target = "" Then Target = "X" Else: Target = ""
> If Not Intersect(Target, Range("plage")) Is Nothing Then
> Selection.Font.ColorIndex = 0
> If Not Intersect(Target, Range("plage")) Is Nothing Then
> Selection.Font.ColorIndex = 0
> Cancel = True
> End Sub