Microsoft 365 Code VBA

jebibo

XLDnaute Occasionnel
Bonsoir Forum

Je sollicite votre aide pour exécuter une macro,

Je voudrais exécuter la macro comme suit:
La feuille "TEMPLATE" est mon modèle à chaque semaine je vais changer le titre donc je Je désir copier une nouvelle feuille et la renommer selon la cellule C2 et effacer le contenu de la feuilles Template.
Donc la semaine suivante j'inscrit mes notes dans l'onglet Template j'exécute le code qui crée une nouvelle feuille et la renomme selon le titre en C2.
Le bouton devra être supprimer également.

Je joint une copie comme exemple.

Merci pour votre aide
Au plaisir
 

Pièces jointes

  • Classeur1.xlsm
    12.4 KB · Affichages: 8

jebibo

XLDnaute Occasionnel
Bonjour M12 et fanfan
J'ai adapté la macro à mon template de suivi cependant cela me donne un code d'erreur
Je ne sais pas trop quel est mon problème.
J'ai presque réussi je demande encore votre aide.
Merci encore une fois
 

Pièces jointes

  • 0000_TEMPLATE_SUIVI_HEBDOMADAIRE.xlsm
    26.8 KB · Affichages: 2
C

Compte Supprimé 979

Guest
Bonjour Jebibo,

Il serait bien, de supprimer les liens avec votre SharePoint avant de donner un fichier :rolleyes:

Sinon il est bien de donner le code erreur et la ligne concernée, exemple :
2022-09-20_03h47_08.png


2022-09-20_03h47_26.png


La raison de ce message, c'est que vous ne déprotégez pas la feuille avant de supprimer les Shapes
Voici le code corrigé
VB:
Sub Test()
  Dim SheetName As String, NewName As String
  Dim Sh As Shape
 
  SheetName = "TEMPLATE"
  NewName = Format(Range("E2"), "yyyy-mm-dd")
  If Not SheetExist(NewName) Then
    Worksheets(SheetName).Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
      .Name = NewName
      .Unprotect
      For Each Sh In .Shapes: Sh.Delete: Next Sh
    End With
  Else
    MsgBox "Impossible de copier la feuille " & SheetName & Chr(10) & NewName & " existe déjà"
  End If
  Sheets("TEMPLATE").Activate
  ActiveSheet.Unprotect
  Range("B8:B17,D8:AB17,AD8:AD17,AF8:BD17,B20:BD23,E2:L2").Select
  Range("E2:I2").Activate
  Selection.ClearContents
  Range("E2:I2").Select
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  ActiveSheet.Range("E2").Value = CDate(Date + 1)

A+
 
Dernière modification par un modérateur:

Discussions similaires

Réponses
5
Affichages
250

Statistiques des forums

Discussions
312 206
Messages
2 086 203
Membres
103 157
dernier inscrit
youma