Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 5 sur 5
  1. #1
    Invité de passage
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 4
    Points
    4

    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 :
    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 :
    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
    Invité de passage
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 4
    Points
    4

    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 Confirmé Sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    8 157
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations forums :
    Inscription : juillet 2008
    Messages : 8 157
    Points : 26 509
    Points
    26 509

    Par défaut

    Dans Module1
    Code :
    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 :
    1
    2
    3
    4
    5
    Sub Rectangle1_QuandClic()
     
    ActiveSheet.Copy after:=ActiveSheet
    Change_Worksheet ActiveSheet, Range("C7")
    End Sub

    Dans module ThisWorkbook
    Code :
    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
    Invité de passage
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 4
    Points
    4

    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 :
    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
    Invité de passage
    Inscrit en
    janvier 2011
    Messages
    16
    Détails du profil
    Informations forums :
    Inscription : janvier 2011
    Messages : 16
    Points : 4
    Points
    4

    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 :
    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 :
    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.

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •