Feuille active - Erreur d'exécution

Le
j-pascal
Bonjour,

J'ai une feuille "janv 07" comportant un "Button 98". Le texte se modifie
via une procédure :
"Private Sub Worksheet_Change(ByVal Target As Range)".

Si je duplique la feuille pour obtenir "fév 07" (etc), j'obtiens le message
suivant :

Erreur d'exécution :
'-2147024809 (80070057)'
L'élément portant ce nom est introuvable

Lors de la duplication, le numéro du "Button" était différent, mais je l'ai
renommé "98" comme celui de la feuille de "jan 07". Si je fais un clic droit
dessus, son nom est bien "98", pourtant j'ai une ligne de "débogage" :
"ActiveSheet.Shapes("Button 98").Select"


J'ai fait une procédure pour chercher le "Button" :

Sub essaiButton()
ActiveSheet.Shapes("Button 98").Select
End Sub

Si je la lance depuis la feuille "fév 07", j'ai le message d'erreur, alors
que le "Button 98" existe bien dans ladite feuille !!

Pour que ça marche, il faut que je fasse :

Sub essaiButton()
'ActiveSheet.Shapes("Button 98").Select
Sheets("fév 07").Select
ActiveSheet.Shapes("Bouton 98").Select
End Sub

Autrement dit, ce n'est pas le "Button" qu'il ne reconnaît pas, mais la
feuille active !

Question : A partir de quoi, puis-je savoir que je suis sur la feuille
active ?
Pour moi, dès lors que je suis sur une feuille et que je saisie une valeur,
je suis par défaut sur la feuille active mais il doit y avoir une
subtilité qui m'échappe !
'ActiveSheet.Shapes("Button 98").Select' signifie bien qu'on sélectionne le
Button 98 de la feuille active, non ?

Au cas où vous en auriez besoin, tout le code de la feuille est là (je sais,
c'est un peu indigeste ;-) )

Merci d'avance pour vos lumières.



--
Dim reponse As Variant

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

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

If Target.Count = 1 Then
With Target
If .NoteText = "" Then
reponse = InputBox("Commentaire?")
If reponse <> "" Then
'.AddComment reponse & Chr(10) & "[" & Hour(Now) &
":" & Minute(Now) & "]"
'.AddComment reponse & Chr(10) & "[" & dd / mm /
yy(Now) & " - " & Hour(Now) & ":" & Minute(Now) & "]"
.AddComment reponse & Chr(10) & "[" & Now() & "]"
With .Comment.Shape.OLEFormat.Object.Font
.Name = "Tverdana"
.Size = 8
.FontStyle = "Normal"
.ColorIndex = 3
End With
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
.Comment.Visible = False
End If
'Else
'.Comment.Delete
End If
End With
End If
Cancel = True

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True ' A
SUPPRIMER ??

End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'modif du 30/07/07

ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ?? 07/08

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
'If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Then
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("Button 98").Select
Selection.Characters.Text = Range("AW3").Value
Range("F6").Select 'désélectionne le bouton ! 'déprotégée 09/08

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True ' A
SUPPRIMER ?? 07/08
ActiveSheet.Protect Password:="", DrawingObjects:úlse, Contents:=True,
Scenarios:úlse
ActiveSheet.EnableSelection = xlUnlockedCells

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
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

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
= 2 'rouge

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 'modif du 30/07/07

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True '
A SUPPRIMER ??

End Sub

Sub creeShape()

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

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
= 2 'rouge

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 11
Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2

Shapes("monshape").OLEFormat.Object.Font.Bold = True


' Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
' Selection.Name = "monshape"
' Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
' Selection.Font.Name = "Verdana"
' Selection.Font.Size = 8
' Selection.Font.ColorIndex = 2
' Selection.Font.Bold = True
' Shapes("monshape").Left = ActiveCell.Left
' Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True ' A
SUPPRIMER ??

End Sub
--


--
Cordialement @+
JP
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
j-pascal
Le #4806711
Bonsoir,

Dans "janv 07", le code fait référence à 'ActiveSheet.Shapes("Button 98").

Quand je duplique la feuille "janv 07", j'ai un message d'erreur bien que le
numéro de "Button" que je vois dans la zone de nom de la feuille semble bon
...

En fait, dans le code de la feuille, il fallait que je change "Button ..."
en "Bouton ..." !!!

Petit mystère, mais ça marche ;-)

JP



"j-pascal"
Bonjour,

J'ai une feuille "janv 07" comportant un "Button 98". Le texte se modifie
via une procédure :
"Private Sub Worksheet_Change(ByVal Target As Range)".

Si je duplique la feuille pour obtenir "fév 07" (etc), j'obtiens le
message suivant :

Erreur d'exécution :
'-2147024809 (80070057)'
L'élément portant ce nom est introuvable

Lors de la duplication, le numéro du "Button" était différent, mais je
l'ai renommé "98" comme celui de la feuille de "jan 07". Si je fais un
clic droit dessus, son nom est bien "98", pourtant j'ai une ligne de
"débogage" : "ActiveSheet.Shapes("Button 98").Select"


J'ai fait une procédure pour chercher le "Button" :

Sub essaiButton()
ActiveSheet.Shapes("Button 98").Select
End Sub

Si je la lance depuis la feuille "fév 07", j'ai le message d'erreur, alors
que le "Button 98" existe bien dans ladite feuille !!

Pour que ça marche, il faut que je fasse :

Sub essaiButton()
'ActiveSheet.Shapes("Button 98").Select
Sheets("fév 07").Select
ActiveSheet.Shapes("Bouton 98").Select
End Sub

Autrement dit, ce n'est pas le "Button" qu'il ne reconnaît pas, mais la
feuille active !

Question : A partir de quoi, puis-je savoir que je suis sur la feuille
active ?
Pour moi, dès lors que je suis sur une feuille et que je saisie une
valeur, je suis par défaut sur la feuille active ... mais il doit y avoir
une subtilité qui m'échappe !
'ActiveSheet.Shapes("Button 98").Select' signifie bien qu'on sélectionne
le Button 98 de la feuille active, non ?

Au cas où vous en auriez besoin, tout le code de la feuille est là (je
sais, c'est un peu indigeste ;-) )

Merci d'avance pour vos lumières.



--------------------------------------------------
Dim reponse As Variant

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

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

If Target.Count = 1 Then
With Target
If .NoteText = "" Then
reponse = InputBox("Commentaire?")
If reponse <> "" Then
'.AddComment reponse & Chr(10) & "[" & Hour(Now) &
":" & Minute(Now) & "]"
'.AddComment reponse & Chr(10) & "[" & dd / mm /
yy(Now) & " - " & Hour(Now) & ":" & Minute(Now) & "]"
.AddComment reponse & Chr(10) & "[" & Now() & "]"
With .Comment.Shape.OLEFormat.Object.Font
.Name = "Tverdana"
.Size = 8
.FontStyle = "Normal"
.ColorIndex = 3
End With
.Comment.Visible = True
.Comment.Shape.Select
Selection.AutoSize = True
.Comment.Visible = False
End If
'Else
'.Comment.Delete
End If
End With
End If
Cancel = True

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True '
A SUPPRIMER ??

End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'modif du 30/07/07

ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ?? 07/08

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
'If Application.Sum(Range("f" & Target.Row & ":" & "m" &
Target.Row)) > 0 Then
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("Button 98").Select
Selection.Characters.Text = Range("AW3").Value
Range("F6").Select 'désélectionne le bouton ! 'déprotégée 09/08

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True '
A SUPPRIMER ?? 07/08
ActiveSheet.Protect Password:="", DrawingObjects:úlse, Contents:=True,
Scenarios:úlse
ActiveSheet.EnableSelection = xlUnlockedCells

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

If Not Intersect(Target, [MoisInterdit]) Is Nothing And Target.Count = 1
Then 'modif du 30/07/07
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

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
= 2 'rouge

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 'modif du 30/07/07

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True
' A SUPPRIMER ??

End Sub

Sub creeShape()

'ActiveSheet.Unprotect Password:="" ' A SUPPRIMER ??

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
= 2 'rouge

Shapes("monshape").OLEFormat.Object.Font.Name = "Verdana"
Shapes("monshape").OLEFormat.Object.Font.Size = 11
Shapes("monshape").OLEFormat.Object.Font.ColorIndex = 2

Shapes("monshape").OLEFormat.Object.Font.Bold = True


' Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 70, 10).Select
' Selection.Name = "monshape"
' Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
' Selection.Font.Name = "Verdana"
' Selection.Font.Size = 8
' Selection.Font.ColorIndex = 2
' Selection.Font.Bold = True
' Shapes("monshape").Left = ActiveCell.Left
' Shapes("monshape").Top = ActiveCell.Top + ActiveCell.Height + 3

'ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True '
A SUPPRIMER ??

End Sub
--------------------------------------------------------------------------


--
Cordialement @+
JP


Publicité
Poster une réponse
Anonyme