Supprimer partie de Macro

Bonjour,

Je souhaiterais qu'à la création de cette feuille, toutes les macros en soient effacés.

Vous connaissez le moyen de le faire ?

Merci d'avance

Julien

Sub creationfeuillerecolte1()
Dim NomFeuil As String, NexistePas As Boolean, Caractere As String

If Range("h4") = 0 Then MsgBox " Veuillez indiquer un rôle !": Exit Sub

NomFeuil = Sheets("parametres").Range("H4")
If Test_Nom_Feuille(NomFeuil, Caractere) = False Then GoTo Faute
On Error Resume Next

NexistePas = Sheets(NomFeuil).Name <> ""
On Error GoTo 0
If NexistePas = False Then
    Sheets("recolte").Copy Before:=Sheets(2)
    ActiveSheet.Name = NomFeuil
    Sheets("parametres").Select

Else
    MsgBox " La feuille n'est pas valide : Feuille déjà existante", vbCritical
End If

Exit Sub

Faute:
MsgBox " La feuille n'est pas valide." & vbCrLf & "Le caractère : " & Caractere & " est interdit.", vbCritical

End Sub

Bonjour Djulito

Il suffit de mettre le code VBA de la feuille dans ThisWorkbook

Tu n'auras plus le problème de supprimer les code

@+

Salut ! Merci de ta réponse.

Du coup en faisant cela, les macros dans "recolte" (la feuille qui est copié) ne marchent plus.

Re,

Merci de joindre un fichier STP, je te montrerais

Salut

En fait j'ai un problème avec ce fichiers. Il est trop lourd pour être hosté sur le forum. Et commme je suis au boulot (Hopital) hyper sécurisé, j'arrive pas à acceder à des sites d'hosting.

Sub creationfeuillerecolte1()
Dim NomFeuil As String, NexistePas As Boolean, Caractere As String

If Range("h4") = 0 Then MsgBox " Veuillez indiquer un rôle !": Exit Sub

NomFeuil = Sheets("parametres").Range("H4")

If Test_Nom_Feuille(NomFeuil, Caractere) = False Then GoTo Faute

On Error Resume Next

NexistePas = Sheets(NomFeuil).Name <> ""
On Error GoTo 0
If NexistePas = False Then

    Sheets("recolte").Copy Before:=Sheets(2)

    ActiveSheet.Name = NomFeuil

    'effacement macro
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
Code = .Lines(1, .CountOfLines)
.DeleteLines 1, .CountOfLines
End With

    Sheets("parametres").Select

Else

    MsgBox " La feuille n'est pas valide : Feuille déjà existante", vbCritical
End If

Exit Sub

Faute:
MsgBox " La feuille n'est pas valide." & vbCrLf & "Le caractère : " & Caractere & " est interdit.", vbCritical

End Sub

J'ai rajouté la ligne effacement macro, mais sans succès.

Re,

Quel est le code de la feuille "récolte" qui ne fonctionne pas

@+

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule

C'est là que s'arrête le déboguage

Re,

Bon désolé, mais je ne comprends plus rien à ce que tu veux

Tu nous dis

Djulito a écrit :

Je souhaiterais qu'à la création de cette feuille, toutes les macros en soient effacés.

Ce qui veut dire que dans la feuille "recolte" il y a du code VBA, mais pas celui que tu me donnes (normalement)

Pour simplifier les choses, je te propose donc de déplacer le code de la feuille dans ThisWorkbook

Mais toujours pas celui que tu donnes qui sert à le supprimer justement

Donc si tu ne sais pas me donner le code de ta feuille "recolte", c'est que tu ne comprends rien à rien

et perso je laisserais tomber

@+

En fait j'ai une feuille "parametres".

Avec un bouton, lorsqu'on clique sur ce bouton, on doit avoir une copie de la feuille "recolte" qui se fait.

Le nom de cette nouvelle feuille se trouve : NomFeuil = Sheets("parametres").Range("H4")

Et cette nouvelle feuille ne doit pas avoir de macro...

C'est un peu chiant de pas pouvoir transférer un fichier...dslé...

Désolé je suis pas très claire. Et j'ai encore du mal à vraiment gérer excel. Mais j'essaye d'apprendre.

Le code dans "recolte" est ci dessous

Quand je le déplace dans ThisWorkbook, les macros dans "recolte" ne marche plus:

J'ai besoin qu'elle y marche. (Mais qu'elles disparaissent dans la copie)

Dim NbLig As Long
Private Sub Worksheet_Activate()
    NbLig = UsedRange.Rows.Count 'Affecte la première valeur à l'activation de la feuille
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If UsedRange.Rows.Count < NbLig Then 'Si moins de lignes après modification
        Application.EnableEvents = False
        Range("X2") = Range("X2") + 1
        Range("X3") = Range("X3") + NbLig - UsedRange.Rows.Count
        NbLig = UsedRange.Rows.Count 'Affecte la nouvelle valeur
        Application.EnableEvents = True
        MsgBox "Suppression de ligne(s) !"
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Shapes("image 1").Top = Target.Top + Target.Height - 15

Shapes("image 1").Left = 2
End Sub

Sub Ins_Ligne()
Rows(ActiveCell.Row + 1).Insert Shift:=xlDown
Range("w2").Value = Range("w2").Value + 1
Worksheets("parametres").Activate
Worksheets("recolte").Activate
End Sub

Re,

Et bien voilà... tu vois quand tu veux

Les événements entre un Sheet et ThisWorkbook sont un peu différents, il ne faut pas les copier tel quel

Sachant que tu renommes la feuille recolte, je ne sais pas comment

NomFeuil = Sheets("parametres").Range("H4")

Je suis parti sur le fait quelles se nomment : recolte, recolte1, recolte2, etc...

Voici le code et évènements à mettre dans ThisWorkbook pour gérer les feuilles "recolteX"

Option Explicit

Dim NbLig As Long

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  ' Si la feuille porte le nom de "recolte"
  If InStr(1, Sh.Name, "recolte") > 0 Then
    NbLig = UsedRange.Rows.Count 'Affecte la première valeur à l'activation de la feuille
  End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  ' Si la feuille porte le nom de "recolte"
  If InStr(1, Sh.Name, "recolte") > 0 Then
    If UsedRange.Rows.Count < NbLig Then 'Si moins de lignes après modification
        Application.EnableEvents = False
        Range("X2") = Range("X2") + 1
        Range("X3") = Range("X3") + NbLig - UsedRange.Rows.Count
        NbLig = UsedRange.Rows.Count 'Affecte la nouvelle valeur
        Application.EnableEvents = True
        MsgBox "Suppression de ligne(s) !"
    End If
  End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  ' Si la feuille porte le nom de "recolte"
  If InStr(1, Sh.Name, "recolte") > 0 Then
    Shapes("image 1").Top = Target.Top + Target.Height - 15
    Shapes("image 1").Left = 2
  End If
End Sub

Tu as aussi celui-là, je ne sais pas s'il il sert, mais à mettre dans un module

Sub Ins_Ligne()
  Rows(ActiveCell.Row + 1).Insert Shift:=xlDown
  Range("w2").Value = Range("w2").Value + 1
  Worksheets("parametres").Activate
  Worksheets("recolte").Activate
End Sub

Comme ça tu n'as plus de souci avec le code de la feuille que tu pourras supprimer

@+

Oui désolé, je n'avais pas vu ta demande du code "recolte" en fait... d'où le malentendu désolé...

Okay super ! J'avance alors ! Merci.

En fait non les feuilles qui vont être copié ne vont pas s'appeller "recolteX."

Elle vont s’appeler en fonction de la valeur d'une cellule qui sera rempli selon la personne qui utilisera le fichier. (H4 de la feuille parametres)

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  ' Si la feuille porte le nom de "recolte"
  If InStr(1, Sh.Name, "recolte") > 0 Then
    Shapes("image 1").Top = Target.Top + Target.Height - 15
    Shapes("image 1").Left = 2
  End If
End Sub

Je met du temps à percuter mais j'y arrive. lol

J'ai mis donc dans thisworkbook.

Mais j'ai erreur de compilation au mot "shapes" : Sub ou Function non definie.(D'ailleurs ca me le fait dans n'importe quel feuil...)

J'ai trouvé ! Il manquait activesheet devant shapes.

Merci beaucoup pour l'aide que tu m'as apporté et ta patience.