1. #1
    Membre à l'essai
    Profil pro
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 10
    Points
    10

    Par défaut code ne fonctionne plus en copiant une feuille pour renommer les onglets

    Bonjour,

    J'utilise le code ci-dessous pour renommer les onglets des feuilles existants dans un classeur:

    dans le module ThisWorkbook
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Nom As String
    Dim NomUtil As String
    Dim Compteur As Integer
     
      If Not Intersect(Range("C7"), Target) Is Nothing And Target.Count = 1 Then
        If Target = "" Then Exit Sub
        Nom = Format(Range("c7"), "dd-mm")
        NomUtil = Nom
        Do While FeuilleExiste(NomUtil) = True
          Compteur = Compteur + 1
          NomUtil = Nom + " - " & Format(Compteur, "00")
        Loop
        Sh.Name = NomUtil
      End If
     
    End Sub
    dans le module standart "Module1"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Function FeuilleExiste(Nom As String) As Boolean
      On Error Resume Next
      FeuilleExiste = Sheets(Nom).Name <> ""
      On Error GoTo 0
    End Function
    J'ai rajouté via un bouton sur une feuille ce code ActiveSheet.Copy after:=ActiveSheetpour copier et coller la feuille

    Mais du coup le code celui qui renomme les onglets ne fonctionne plus;;

    quelqu'un a une idée?

    Amicalement

  2. #2
    Membre à l'essai
    Profil pro
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 10
    Points
    10

    Par défaut

    Bonjour,

    Je vous joint un fichier exemple qui est un explicatif.

    En vous remerciant pour votre aide
    Fichiers attachés Fichiers attachés

  3. #3
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    8 556
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations forums :
    Inscription : juillet 2008
    Messages : 8 556
    Points : 27 719
    Points
    27 719

    Par défaut

    Dans Module1
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    Sub Change_Worksheet(ByVal Sh As Object, ByVal Target As Range)
    Dim Nom As String, NomUtil As String
    Dim Compteur As Integer
     
    If Target.Address = "$C$7" Then
        If Target <> "" Then
            Nom = Format(Target, "dd-mm")
            NomUtil = Nom
            Do While FeuilleExiste(NomUtil)
                Compteur = Compteur + 1
                NomUtil = Nom & " - " & Format(Compteur, "00")
            Loop
            Sh.Name = NomUtil
        End If
    End If
    End Sub
     
    Private Function FeuilleExiste(Nom As String) As Boolean
     
    On Error Resume Next
    FeuilleExiste = Sheets(Nom).Name <> ""
    On Error GoTo 0
    End Function

    Dans Module2 (d'ailleurs tu pouvais mettre un seul module)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Sub Rectangle1_QuandClic()
     
    ActiveSheet.Copy after:=ActiveSheet
    Change_Worksheet ActiveSheet, Range("C7")
    End Sub

    Dans module ThisWorkbook
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
     
    Change_Worksheet Sh, Target
     
    End Sub
    Cordialement.

  4. #4
    Membre à l'essai
    Profil pro
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 10
    Points
    10

    Par défaut

    Bonjour mercatog,Bonjour tout le monde,

    Merci beaucoup ca marche trés bien la premiere partie.

    Pour la deuxieme partie j'ai essayé ce code pour imprimer la feuille masquée a partir de n'importe quelle feuille du fichier, j'arrive a imprimer mais ca copie pas les cellule..

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Sub Rectangle4_QuandClic()
    Selection.Copy
        Sheets("IMPRESSION").Select
        Range("B9").Select
        ActiveSheet.Paste
        Sheets("12-12").Select
        Range("F10").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("IMPRESSION").Select
        Range("C9").Select
        ActiveSheet.Paste
    Application.Dialogs(xlDialogPrinterSetup).Show
     
    Sheets("IMPRESSION").Visible = True
    Sheets("IMPRESSION").Activate
    Sheets("IMPRESSION").PrintOut
    Sheets("IMPRESSION").Visible = False
    End Sub

    A vous lire et merci d'avance

  5. #5
    Membre à l'essai
    Profil pro
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 10
    Points
    10

    Par défaut

    Bonjour,

    Mon souci est résolu je tien à remercier banzai 64 et kijn pour leur aide ci dessous le code (autre forum)


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Sub Impression()
    Application.ScreenUpdating = False
    Set ws = Sheets("Impression")
    With ws
        .Range("C5") = Range("B10")
        .Range("C9") = Range("C11") & Range("F10")
        .Visible = True
        .PrintOut
        .Visible = False
    End With
    End Sub
    Ou

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Sub Rectangle4_QuandClic()
     
      Application.ScreenUpdating = False
      With Sheets("Impression")
        .Range("C5") = Range("C11")
        .Range("C9") = Range("F10")
        .Visible = xlSheetVisible
        .PrintPreview       ' Pour avoir aperçu avant impression
       ' Ou
       '.PrintOut           ' Pour impression directe
       .Visible = xlSheetHidden
      End With
    End Sub

    Merci aussi a mercatog pour la première partie

    Cordialement

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Le code ne fonctionne plus dans une fonction
    Par Yukiho dans le forum Fonctions
    Réponses: 0
    Dernier message: 12/03/2010, 11h19
  2. Erreur d'éxécution d'une macro pour renommer un onglet
    Par cuterate dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 29/10/2009, 11h38
  3. Code ne fonctionne plus quand j'ai splitté la base
    Par jloois dans le forum VBA Access
    Réponses: 10
    Dernier message: 05/03/2009, 22h33
  4. Codes ne fonctionnant plus !
    Par PC_BE dans le forum VB.NET
    Réponses: 4
    Dernier message: 16/04/2008, 14h27
  5. Réponses: 1
    Dernier message: 23/05/2007, 18h02

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo