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

suppression de graphiques

2 réponses
Avatar
gaylord
Bonjour

Mes feuilles sont nommées de 1 à 52 (numéro de semaine)
Chaque semaine je crée une nouvelle avec la formule suivante :

Private Sub CommandButton1_Click()
Cells.Select
Sheets("modèle").Select
Sheets("modèle").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Application.InputBox(prompt:="Entrez un Nouveau
Nom", Title:="Nom de la nouvelle feuille", Type:=2)
ActiveSheet.Range("a1").Value = ActiveSheet.Name
End Sub

Je voudrais ajouter une fonction qui supprimerait les graphiques de la
semaine n-10.

Sheets("23").Select
ActiveSheet.ChartObjects("Graphique 2").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 3").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

JE n'arrive pas à remplacer le 23 par une formule permettant de
calculer :
(feuille active - 10)
par exemple je crée la semaine 35 et les graphiques de la semaine 25
sont supprimé.

Merci d'avance
Bonne journée

2 réponses

Avatar
pmo
Bonjour,

Faites une copie de votre classeur et essayez
la macro ci-dessous.
La macro va, dans un premier temps, rechercher
la semaine la plus élevée puis sélectionner la
feuille "semaine la plus élevée - 10" et y détruire
TOUS les graphiques incorporés.

Salutations.

PMO

'*************************************
Sub Supprime_Graph()
Dim A$
Dim S As Worksheet
Dim LastWeek&
Dim C As ChartObject
Application.ScreenUpdating = False
'---- Détermination de la semaine la plus élevée ----
For Each S In Worksheets
If IsNumeric(S.Name) Then
If CLng(S.Name) > LastWeek& Then
LastWeek& = CLng(S.Name)
End If
End If
Next S
'---- Activation de la feuille "n-10" ----
A$ = ActiveSheet.Name
On Error GoTo neant
Sheets(CStr(LastWeek - 10)).Activate
On Error GoTo 0
'---- Destruction des graphiques incorporés ----
For Each C In ActiveSheet.ChartObjects
C.Delete
Next C
'---- Activation de la feuille d'origine ----
Sheets(A$).Activate
Application.ScreenUpdating = True
Exit Sub
neant:
MsgBox prompt:="La feuille ''" & LastWeek - 10 & _
"'' n'existe pas.", _
Buttons:=vbOKOnly
Application.ScreenUpdating = True
End Sub
'*************************************


-----Message d'origine-----
Bonjour

Mes feuilles sont nommées de 1 à 52 (numéro de semaine)
Chaque semaine je crée une nouvelle avec la formule
suivante :


Private Sub CommandButton1_Click()
Cells.Select
Sheets("modèle").Select
Sheets("modèle").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Application.InputBox(prompt:="Entrez
un Nouveau

Nom", Title:="Nom de la nouvelle feuille", Type:=2)
ActiveSheet.Range("a1").Value = ActiveSheet.Name
End Sub

Je voudrais ajouter une fonction qui supprimerait les
graphiques de la

semaine n-10.

Sheets("23").Select
ActiveSheet.ChartObjects("Graphique 2").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 3").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

JE n'arrive pas à remplacer le 23 par une formule
permettant de

calculer :
(feuille active - 10)
par exemple je crée la semaine 35 et les graphiques de
la semaine 25

sont supprimé.

Merci d'avance
Bonne journée
.



Avatar
AV
A ajouter en fin du code de création de la nouvelle feuille :

On Error Resume Next
Sheets(ActiveSheet.Index - 10).DrawingObjects.Delete

AV

"gaylord" a écrit dans le message news:

Bonjour

Mes feuilles sont nommées de 1 à 52 (numéro de semaine)
Chaque semaine je crée une nouvelle avec la formule suivante :

Private Sub CommandButton1_Click()
Cells.Select
Sheets("modèle").Select
Sheets("modèle").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Application.InputBox(prompt:="Entrez un Nouveau
Nom", Title:="Nom de la nouvelle feuille", Type:=2)
ActiveSheet.Range("a1").Value = ActiveSheet.Name
End Sub

Je voudrais ajouter une fonction qui supprimerait les graphiques de la
semaine n-10.

Sheets("23").Select
ActiveSheet.ChartObjects("Graphique 2").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects("Graphique 3").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

JE n'arrive pas à remplacer le 23 par une formule permettant de
calculer :
(feuille active - 10)
par exemple je crée la semaine 35 et les graphiques de la semaine 25
sont supprimé.

Merci d'avance
Bonne journée