[Toutes versions] code ne fonctionne plus en copiant une feuille pour renommer les onglets [Résolu]

[tazko]

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

[tazko]

Bonjour,

Je vous joint un fichier exemple qui est un explicatif.

En vous remerciant pour votre aide

[mercatog]

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

[tazko]

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

[tazko]

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