Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

(vba) appeler code de Feuil

17 réponses
Avatar
j-pascal
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le code
dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP

10 réponses

1 2
Avatar
Daniel
Bonjour.
Sub toto()
Sheets(1).test
End Sub
Cordialement.
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP


Avatar
Philippe.R
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un module
ordinaire et d'appeler cette Sub (gentiment, par le petit nom qu'on lui a
donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP


Avatar
papou
Bonjour
Sinon, et si c'est adapté à ton cas, regarde aussi du côté des évènements
accessibles au niveau de Thisworkbook.

Cordialement
Pascal

"j-pascal" a écrit dans le message de news:

Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP


Avatar
j-pascal
Bonjour,

En fait, comme cela concerne principalement des procédures événementielles :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas possible... Mais
avais-je précisé qu'il s'agissait de telles procédures ? :o) En même temps,
quelle genre de procédures pouvais-je mettre dans un module de feuille à
part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute à
présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
%
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un module
ordinaire et d'appeler cette Sub (gentiment, par le petit nom qu'on lui a
donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP





Avatar
j-pascal
Bonjour,

Il y a déjà bcp de chose de ce côté là ... et je ne veux pas que ces
procédures de Feuille affectent TOUTES les feuilles (autres que les 12 dont
j'ai parlé).

Cordialement,

JP

"papou" <cpapoupasbon@çanonpluslaposte.net> a écrit dans le message de news:
e$
Bonjour
Sinon, et si c'est adapté à ton cas, regarde aussi du côté des évènements
accessibles au niveau de Thisworkbook.

Cordialement
Pascal

"j-pascal" a écrit dans le message de news:

Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP






Avatar
Daniel
Regarde dans "ThisWorkbook" :
Workbook_SheetChange
Workbook_SheetSelectionChange
et Sheets("Feuilx").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

En fait, comme cela concerne principalement des procédures événementielles
:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas possible...
Mais avais-je précisé qu'il s'agissait de telles procédures ? :o) En même
temps, quelle genre de procédures pouvais-je mettre dans un module de
feuille à part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute à
présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
%
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un module
ordinaire et d'appeler cette Sub (gentiment, par le petit nom qu'on lui a
donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP








Avatar
j-pascal
Re,

Désolé, je ne comprends pas !

Dois-je ajouter ces procédures dans ThisWorkbook ?
Si oui, ne vont-elles pas affecter toutes les feuilles ?
Pour moi, le code placé dans ThisWorkbook affecte tout le classeur (d'où
module de fermeture, d'ouverture, etc) et le code de Feuil affecte seulement
la Feuille !

JP

"Daniel" a écrit dans le message de news:

Regarde dans "ThisWorkbook" :
Workbook_SheetChange
Workbook_SheetSelectionChange
et Sheets("Feuilx").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

En fait, comme cela concerne principalement des procédures
événementielles :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas possible...
Mais avais-je précisé qu'il s'agissait de telles procédures ? :o) En
même temps, quelle genre de procédures pouvais-je mettre dans un module
de feuille à part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute à
présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
%
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un module
ordinaire et d'appeler cette Sub (gentiment, par le petit nom qu'on lui
a donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP












Avatar
Daniel
Tu remplaces les procédures Private Sub Worksheet_Change
de chacune de tes feuilles par une seule procédure Workbook_SheetChange dans
ThisWorkBook
de même pour l'autre.
Pour appeler la macro creeShape de Feuil1, tu mets :
Sheets("Feuil1").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Re,

Désolé, je ne comprends pas !

Dois-je ajouter ces procédures dans ThisWorkbook ?
Si oui, ne vont-elles pas affecter toutes les feuilles ?
Pour moi, le code placé dans ThisWorkbook affecte tout le classeur (d'où
module de fermeture, d'ouverture, etc) et le code de Feuil affecte
seulement la Feuille !

JP

"Daniel" a écrit dans le message de news:

Regarde dans "ThisWorkbook" :
Workbook_SheetChange
Workbook_SheetSelectionChange
et Sheets("Feuilx").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

En fait, comme cela concerne principalement des procédures
événementielles :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas possible...
Mais avais-je précisé qu'il s'agissait de telles procédures ? :o) En
même temps, quelle genre de procédures pouvais-je mettre dans un module
de feuille à part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute à
présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
%
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un
module ordinaire et d'appeler cette Sub (gentiment, par le petit nom
qu'on lui a donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder le
code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP















Avatar
j-pascal
Bonsoir Daniel,

J'ai essayé de faire ce que tu proposes ... si tant est que j'aie compris !
J'ai laissé creeShape dans Feuil1 (en réalité sheets(5)), je ne suis pas sûr
de savoir comment l'appeler ...
Si je fais des essais avec la feuille5 les événements ne sont pas pris en
compte !

Le code de ThisWorkbook est là, mais franchement je ne t'en voudrais pas du
tout de ne pas y mettre le nez car c'est AMHA un peu indigeste (à la fin
j'ai une question subsidiaire ...) :

'--------------------------------------------------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst

If SaveAsUI Then
MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"
Cancel = True
Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : " &
"Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name
Else
Cancel = True
End If
End With
End If


Dim Sh As Worksheet

Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each Sh In ThisWorkbook.Sheets
Sh.Protect userinterfaceonly:=True 'indispensable ??
If Sh.CodeName <> "Feuil15" Then
Sh.Visible = xlSheetVeryHidden
End If
Next
End Sub


'------------------------------------- début essai du 27/08

Dim reponse As Variant

Private Sub Workbook_Sheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)

If (Target.Row > 8 And Target.Row < 111) And (Target.Column < 47 And
Target.Column > 15) Then
If Target.Count = 1 Then
With Target
If .NoteText = "" Then
reponse = InputBox("Notez votre commentaire...")
If reponse <> "" Then
'.AddComment reponse & Chr(10) & "[" & Now() & "]"
.AddComment reponse & Chr(10) & Chr(10) & "" &
Format(Now, "dd mmm yy - hh""h""nn") & ""
With .Comment.Shape.OLEFormat.Object.Font
.Name = "Tverdana"
.Size = 9
.FontStyle = "bold"
.ColorIndex = 13
End With
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
'ajout 15/08
.Comment.Visible = False
End If
'Else
'.Comment.Delete
End If
End With
End If
End If
Cancel = True
End Sub

Private Sub Workbook_Sheet_Change(ByVal Target As Range)
'------------------------------------------
' If Not Intersect(Target, [P9:AT110]) Is Nothing And Target.Count = 1
Then
' [mémoire].Interior.ColorIndex = xlNone
' ActiveWorkbook.Names.Add Name:="mémoire", RefersTo:="=" & Range("c"
& Target.Row).Address & ""
' Range("c" & Target.Row).Interior.ColorIndex = 3
' End If
'------------------------------------------
If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count =
1 Then
Application.EnableEvents = False
compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then
Target = [mémo]
MsgBox "Vous ne devez pas supprimer ce Nom !" & Chr(10)
& Chr(10) & "(La ligne contient des informations ...)", vbOKOnly +
vbInformation, "Attention !"
End If
End If

Application.EnableEvents = True

ActiveSheet.Shapes("Bouton 2").Select
Selection.Characters.Text = Range("AW3").Value
Range("F6").Select 'désélectionne le bouton !

ActiveSheet.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Private Sub Workbook_Sheet_SelectionChange(ByVal Target As Range) '27/08

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0

For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then
On Error Resume Next
Shapes("monshape").Visible = True
'If Err <> 0 Then creeShape: Target.Select
If Err <> 0 Then Sheets(5).creeShape: Target.Select 'sans
conviction ;-(
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top +
ActiveCell.Height + 1
Shapes("monshape").TextFrame.Characters.Text =
"Suppression interdite !"
Shapes("monshape").OLEFormat.Object.AutoSize = True
Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21 'bleu pétrole
Shapes("monshape").OLEFormat.Object.Font.Name =
"Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 9
'modif 09/08
Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True
Else
On Error Resume Next
Shapes("monshape").Visible = False
End If
End If
End Sub

'Private Sub creeShape()
'
' Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
' Selection.Name = "monshape"
' Shapes("monshape").Left = ActiveCell.Left
' Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 1
' Shapes("monshape").OLEFormat.Object.AutoSize = True
'
Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor =
21
' Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
' Shapes("monshape").OLEFormat.Object.Font.Size = 9
' Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
' Shapes("monshape").OLEFormat.Object.Font.Bold = True
'
'End Sub

'----------------------------------------------------------------

J'ai lu attentivement les explications de Stéphane sur la numérotation des
feuilles, mais dans le cas qui suit, je ne comprends pas un truc :
Dans Microsoft Excel Objets, j'ai Feuil1 (Janv 07) mais pour sélectionner
cette feuille, je dois faire Sheets(5).select. Je le sais parce que j'ai
fait des essais ! Mais où puis-je trouver l'info que cette feuille "Janv 07"
correspond à 5 ?? Un mystère pour moi !

@+ ?

JP

"Daniel" a écrit dans le message de news:
%
Tu remplaces les procédures Private Sub Worksheet_Change
de chacune de tes feuilles par une seule procédure Workbook_SheetChange
dans ThisWorkBook
de même pour l'autre.
Pour appeler la macro creeShape de Feuil1, tu mets :
Sheets("Feuil1").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Re,

Désolé, je ne comprends pas !

Dois-je ajouter ces procédures dans ThisWorkbook ?
Si oui, ne vont-elles pas affecter toutes les feuilles ?
Pour moi, le code placé dans ThisWorkbook affecte tout le classeur (d'où
module de fermeture, d'ouverture, etc) et le code de Feuil affecte
seulement la Feuille !

JP

"Daniel" a écrit dans le message de news:

Regarde dans "ThisWorkbook" :
Workbook_SheetChange
Workbook_SheetSelectionChange
et Sheets("Feuilx").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

En fait, comme cela concerne principalement des procédures
événementielles :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas possible...
Mais avais-je précisé qu'il s'agissait de telles procédures ? :o) En
même temps, quelle genre de procédures pouvais-je mettre dans un module
de feuille à part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute
à présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de
news: %
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un
module ordinaire et d'appeler cette Sub (gentiment, par le petit nom
qu'on lui a donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder
le code dans une seule "Feuil" et de l'appeler depuis les 11 autres ?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP



















Avatar
Daniel
Regarde le classeur à l'adresse : http://cjoint.com/?iBve3BeZuD
J'ai mis des messeboxes dans les évènements :
Private Sub Worksheet_Change
et
Workbook_SheetSelectionChange
Pour creeShape, tu la laisses dans Feuil1 et tu l'appelles depuis les autres
feuilles en écrivant sheets("Feuil1").creeShape
Pour la question subsidiaire, Sheets(1) désigne la feuille la plus à gauche,
donc Sheets(5), la 5e feuille depuis la gauche. Si tu changes les feuilles
de place, leur numéro change.
Pour trouver le numéro d'index :
MsgBox Sheets("Janv 07").Index
Daniel
"j-pascal" a écrit dans le message de news:

Bonsoir Daniel,

J'ai essayé de faire ce que tu proposes ... si tant est que j'aie compris
!
J'ai laissé creeShape dans Feuil1 (en réalité sheets(5)), je ne suis pas
sûr de savoir comment l'appeler ...
Si je fais des essais avec la feuille5 les événements ne sont pas pris en
compte !

Le code de ThisWorkbook est là, mais franchement je ne t'en voudrais pas
du tout de ne pas y mettre le nez car c'est AMHA un peu indigeste (à la
fin j'ai une question subsidiaire ...) :

'--------------------------------------------------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)

Dim tst

If SaveAsUI Then
MsgBox "Désolé, l'option Enregistrer sous... est impossible !",
vbExclamation, "choix possibles : Enregistrer ou Fermer"
Cancel = True
Else
tst = MsgBox("Voulez-vous enregistrer une copie sous la forme : " &
"Date Heure Fichier.xls" & " ?", vbYesNo)
'& vbCrLf &

With ThisWorkbook
ChDir .Path
If tst = 6 Then
.SaveCopyAs Format(Now, "yyyymmmdd-hh""h""nn") & " " &
.Name
Else
Cancel = True
End If
End With
End If


Dim Sh As Worksheet

Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
Sheets("accueil").Visible = xlSheetVisible 'Feuil15.Visible

For Each Sh In ThisWorkbook.Sheets
Sh.Protect userinterfaceonly:=True 'indispensable ??
If Sh.CodeName <> "Feuil15" Then
Sh.Visible = xlSheetVeryHidden
End If
Next
End Sub


'------------------------------------- début essai du 27/08

Dim reponse As Variant

Private Sub Workbook_Sheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)

If (Target.Row > 8 And Target.Row < 111) And (Target.Column < 47 And
Target.Column > 15) Then
If Target.Count = 1 Then
With Target
If .NoteText = "" Then
reponse = InputBox("Notez votre commentaire...")
If reponse <> "" Then
'.AddComment reponse & Chr(10) & "[" & Now() & "]"
.AddComment reponse & Chr(10) & Chr(10) & "" &
Format(Now, "dd mmm yy - hh""h""nn") & ""
With .Comment.Shape.OLEFormat.Object.Font
.Name = "Tverdana"
.Size = 9
.FontStyle = "bold"
.ColorIndex = 13
End With
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
Selection.ShapeRange.Fill.ForeColor.SchemeColor =
44 'ajout 15/08
.Comment.Visible = False
End If
'Else
'.Comment.Delete
End If
End With
End If
End If
Cancel = True
End Sub

Private Sub Workbook_Sheet_Change(ByVal Target As Range)
'------------------------------------------
' If Not Intersect(Target, [P9:AT110]) Is Nothing And Target.Count = 1
Then
' [mémoire].Interior.ColorIndex = xlNone
' ActiveWorkbook.Names.Add Name:="mémoire", RefersTo:="=" &
Range("c" & Target.Row).Address & ""
' Range("c" & Target.Row).Interior.ColorIndex = 3
' End If
'------------------------------------------
If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count =
1 Then
Application.EnableEvents = False
compteur = 0
For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then
Target = [mémo]
MsgBox "Vous ne devez pas supprimer ce Nom !" & Chr(10)
& Chr(10) & "(La ligne contient des informations ...)", vbOKOnly +
vbInformation, "Attention !"
End If
End If

Application.EnableEvents = True

ActiveSheet.Shapes("Bouton 2").Select
Selection.Characters.Text = Range("AW3").Value
Range("F6").Select 'désélectionne le bouton !

ActiveSheet.Protect Password:="", DrawingObjects:úlse,
Contents:=True, Scenarios:úlse
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Private Sub Workbook_Sheet_SelectionChange(ByVal Target As Range) '27/08

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count =
1 Then
ActiveWorkbook.Names.Add Name:="mémo", RefersToR1C1:="=" & Chr(34) &
Target.Value & Chr(34)

compteur = 0

For Each com In Range("p" & Target.Row & ":at" & Target.Row)
If Len(com.NoteText) Then compteur = 1: Exit For
Next
If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Or compteur = 1 Then
On Error Resume Next
Shapes("monshape").Visible = True
'If Err <> 0 Then creeShape: Target.Select
If Err <> 0 Then Sheets(5).creeShape: Target.Select 'sans
conviction ;-(
Shapes("monshape").Left = ActiveCell.Left
Shapes("monshape").Top = ActiveCell.Top +
ActiveCell.Height + 1
Shapes("monshape").TextFrame.Characters.Text =
"Suppression interdite !"
Shapes("monshape").OLEFormat.Object.AutoSize = True

Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21 'bleu pétrole
Shapes("monshape").OLEFormat.Object.Font.Name =
"Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 9
'modif 09/08
Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
Shapes("monshape").OLEFormat.Object.Font.Bold = True
Else
On Error Resume Next
Shapes("monshape").Visible = False
End If
End If
End Sub

'Private Sub creeShape()
'
' Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
' Selection.Name = "monshape"
' Shapes("monshape").Left = ActiveCell.Left
' Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 1
' Shapes("monshape").OLEFormat.Object.AutoSize = True
'
Shapes("monshape").OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor
= 21
' Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
' Shapes("monshape").OLEFormat.Object.Font.Size = 9
' Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2
' Shapes("monshape").OLEFormat.Object.Font.Bold = True
'
'End Sub

'----------------------------------------------------------------

J'ai lu attentivement les explications de Stéphane sur la numérotation des
feuilles, mais dans le cas qui suit, je ne comprends pas un truc :
Dans Microsoft Excel Objets, j'ai Feuil1 (Janv 07) mais pour sélectionner
cette feuille, je dois faire Sheets(5).select. Je le sais parce que j'ai
fait des essais ! Mais où puis-je trouver l'info que cette feuille "Janv
07" correspond à 5 ?? Un mystère pour moi !

@+ ?

JP

"Daniel" a écrit dans le message de news:
%
Tu remplaces les procédures Private Sub Worksheet_Change
de chacune de tes feuilles par une seule procédure Workbook_SheetChange
dans ThisWorkBook
de même pour l'autre.
Pour appeler la macro creeShape de Feuil1, tu mets :
Sheets("Feuil1").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Re,

Désolé, je ne comprends pas !

Dois-je ajouter ces procédures dans ThisWorkbook ?
Si oui, ne vont-elles pas affecter toutes les feuilles ?
Pour moi, le code placé dans ThisWorkbook affecte tout le classeur (d'où
module de fermeture, d'ouverture, etc) et le code de Feuil affecte
seulement la Feuille !

JP

"Daniel" a écrit dans le message de news:

Regarde dans "ThisWorkbook" :
Workbook_SheetChange
Workbook_SheetSelectionChange
et Sheets("Feuilx").creeShape
Daniel
"j-pascal" a écrit dans le message de news:

Bonjour,

En fait, comme cela concerne principalement des procédures
événementielles :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Private Sub creeShape() 'celle-ci ne l'est pas !

... je ne serais pas surpris d'apprendre que cela n'est pas
possible... Mais avais-je précisé qu'il s'agissait de telles
procédures ? :o) En même temps, quelle genre de procédures pouvais-je
mettre dans un module de feuille à part celles-ci ?

En supposant que ma question initiale ait été claire (ce dont je doute
à présent), est-il possible d'appeler un : "Private Sub
Worksheet_BeforeDoubleClick" ?

@+ ?

JP





"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de
news: %
Bonjour,
Dans cet esprit, le mieux est de mettre le code dans une Sub d'un
module ordinaire et d'appeler cette Sub (gentiment, par le petit nom
qu'on lui a donné) dans l'évènement de feuil qui va bien.
--
Avec plaisir
Philippe.R
"j-pascal" a écrit dans le message de
news:
Bonjour,

J'ai le même code dans 12 "Feuil" (sous Microsoft Excel Objets)

Est-il possible (afin de faciliter son actualisation ...) de garder
le code dans une seule "Feuil" et de l'appeler depuis les 11 autres
?

J'imagine que non, mais bon ...

Merci ;-)

--
Cordialement @+
JP






















1 2