Création onglet avec condition en VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

1 pièce(s) jointe(s)

Création onglet avec condition en VBA

Bonjour
Pour créer des onglets à partir de deux modèles (QUANTI ou QUALI)

J'ai mis ce code pour l'onglet rapport

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Private Sub Worksheet_Change(ByVal Target As Range)
    Trouv = False
    'Test si la cellule est bien en colonne P (colonne 16 )
    If Target.Column = 16 Then
        'Test si la cellule est bien avant la ligne (pas de génération de feuille dont le nom est : " ")
        If Target.Row < 283 Then
            Onglet = Cells(Target.Row, 1).Value
            'Test si la cellule contient "quanti" (Lcase met obligatoirement en minuscule toute chaine de caractère)
            If LCase(Target.Value) = "quanti" Then
                'on test le nom des feuilles et si on la trouve alors Trouv = True
                For Each Sheet In Sheets
                    If Sheet.Name = Onglet Then
                        Trouv = True
                        Exit For
                    End If
                Next
                'Si on l'a trouvé on l'affiche sinon il faut la créer
                If Trouv = True Then
                    Sheets(Onglet).Visible = True
                Else
 
                    'on copie la feuille Model en dernier
                    Sheets("MODELCOMPQUANTI").Visible = True
                    Sheets("MODELCOMPQUANTI").Copy After:=Sheets(Sheets.Count)
                    Sheets("MODELCOMPQUANTI").Visible = False
                    'on renomme cette derniere
                    Sheets(Sheets.Count).Name = Onglet
                    Sheets(Sheets.Count).Visible = True
                End If
             Else
                For Each Sheet In Sheets
                    If Sheet.Name = Onglet Then
                        Trouv = True
                        Exit For
                    End If
                Next
                'Si on l'a trouvé on l'affiche sinon il faut la créer
                If Trouv = True Then
                 Sheets(Sheets.Count).Visible = True
                End If
             End If
        End If
    End If
 Trouv = False
    'Test si la cellule est bien en colonne Q (colonne 17 )
    If Target.Column = 17 Then
        'Test si la cellule est bien avant la ligne (pas de génération de feuille dont le nom est : " ")
        If Target.Row < 283 Then
 
            Onglet = Cells(Target.Row, 1).Value
            'Test si la cellule contient "quali" (Lcase met obligatoirement en minuscule toute chaine de caractère)
            If LCase(Target.Value) = "quali" Then
                'on test le nom des feuilles et si on la trouve alors Trouv = True
                For Each Sheet In Sheets
                    If Sheet.Name = Onglet Then
                        Trouv = True
                        Exit For
                    End If
                Next
                'Si on l'a trouvé on l'affiche sinon il faut la créer
                If Trouv = True Then
                    Sheets(Onglet).Visible = True
                Else
 
                    'on copie la feuille Model en dernier
                    Sheets("MODELCOMPQUALI").Visible = True
                    Sheets("MODELCOMPQUALI").Copy After:=Sheets(Sheets.Count)
                    Sheets("MODELCOMPQUALI").Visible = False
                    'on renomme cette derniere
                    Sheets(Sheets.Count).Name = Onglet
                    Sheets(Sheets.Count).Visible = True
                End If
             Else
                For Each Sheet In Sheets
                    If Sheet.Name = Onglet Then
                        Trouv = True
                        Exit For
                    End If
                Next
                'Si on l'a trouvé on l'affiche sinon il faut la créer
                If Trouv = True Then
                 Sheets(Sheets.Count).Visible = True
                End If
             End If
        End If
    End If
End Sub

Il fonctionne si au départ de l'utilisation les onglets MODELCOMPA QUANTI ET MODELCOMPAQUALI ne sont pas cachés , mais je souhaiterai pouvoir les cacher dès le début mais dans ce cas les onglets créés ne sont pas bons . Création du dernier onglet et non pas des onglets qui intéressement .
Je ne trouve pas l'erreur, mais je ne suis pas très douée...
Si quelqu'un peut m'aider
Je vous joins en pj mon tableur

01/07/2019, 18h55
Patrice740

Bonjour,

Le post est illisible, merci d'utiliser les balises CODE :
http://club.developpez.com/aidenouve...es/Balises.gif
https://www.developpez.net/forums/d3...-balises-code/
01/07/2019, 20h10
patricktoulon

re
re
bonjour pour tester si un sheets existe tu n'est pas forcé de boucler sur tout les sheets et vérifier leur nom
une simple petite formule évaluée avec evaluate
ici si le sheets toto n'existe pas ca te donnera faux sinon vrai
Code:

1 2 3 Sub test() MsgBox Not IsError(Evaluate("='" & "toto" & "'!A1")) End Sub
et surtout combien même il serait caché ,si il existe se sera "vrai" !!
;)
01/07/2019, 21h06
Arkham46

Citation:

Envoyé par patricktoulon

une simple petite formule évaluée avec evaluate

Bonjour,

La simplicité ne se mesure pas au nombre de lignes de code.
Et si la cellule A1 de la feuille contient une erreur ?
Formule simple, oui mais erronée.

Sinon : entrer en debug pas à pas pour analyser ce qui passe.

re

bonsoir Arkham

que cela te tienne
on evalue plus une valeur mais un object range 2d msgbox a l'appui si le premier ne renvoie pas d'erreur le 2d renvoie bien un object range

que pense tu de celle ci
Code:

1 2 3 4 Sub test2() MsgBox Not IsError(Evaluate("='" & "toto" & "'!A1:z100")) MsgBox TypeName(Evaluate("'toto'!A1:z100")) End Sub
JE viens de tester avec des #REF,#VALEUR,etc...

l'évaluation renvoie une erreur ou un object range

pour le coup effectivement plus de soucis avec les cellules avec des erreurs éventuelles
;)
dans une fonction ca donnerait ca
Code:

1 2 3 4 5 6 7 8 9 Function sheetsExiste(sname As String) sheetsExiste = Not IsError(Evaluate("='" & sname & "'!A1:z100")) End Function ' ' Sub test3() MsgBox sheetsExiste("titi") MsgBox sheetsExiste("toto") End Sub
j'avais péché la première sur le net il y a longtemps
pour le coup merci de m'avoir mis le doigt sur un point que je n'avais pas envisagé
du coup je vais changer ca dans mes fichiers pour la mienne yes!!

re
et donc si j'ai bien compris les intention de la demande

je remplace tout son code par ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function sheetsExiste(sname As String)
    sheetsExiste = Not IsError(Evaluate("='" & sname & "'!A1:z100"))
End Function
'
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim onglet$
    'Test si la cellule est bien en colonne (16 ou 17 )
    Select Case Target.Column
    Case 16, 17
        If Target.Row < 283 Then
            onglet = Cells(Target.Row, 1).Value
            Select Case LCase(Target.Value)
            Case "quanti", "quali"
                If sheetsExiste(onglet) Then
                    Sheets(onglet).Visible = True
                Else
                    'on copie la feuille Model en dernier
                    Sheets("MODELCOMP" & UCase(Target.Value)).Visible = True
                    Sheets("MODELCOMP" & UCase(Target.Value)).Copy After:=Sheets(Sheets.Count)
                    Sheets("MODELCOMP" & UCase(Target.Value)).Visible = False
                    'on renomme cette derniere
                    Sheets(Sheets.Count).Name = onglet
                    Sheets(Sheets.Count).Visible = True
                End If
            End Select
        Else
            If sheetsExiste(onglet) Then' la je pige pas trop ce else mais je n'ai pas tout le contexte
                Sheets(Sheets.Count).Visible = True
            End If
        End If
 
    End Select
End Sub

02/07/2019, 07h38
Arkham46

Bonjour,

Pour tester l'existence d'une feuille :
- soit on boucle comme c'était fait initialement
- soit on essaye d'accéder à la feuille et on capture l'éventuelle erreur

Pourquoi prendre un risque avec une autre méthode ?
De plus côté performance je ne suis pas convaincu que ce soit mieux.

Ceci dit, je peine à comprendre le problème initial qui mériterait plus d'explications.

re
bonjour Arkham

pour le risque je vois pas trop ou il est a évaluer une formule devant renvoyé un object range (tableau)
pour les performances ben y a pas photo
testé avec 506 sheets dont le derniers se nomme "toto"
la méthode evaluate toujours 0: testé 20 fois d'affilé
la méthode boucle des fois 0 des fois un peu plus de 0,04xxxx : testé 20 fois d'affilé
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Function sheetsExiste1(sname As String) As Boolean For Each sh In Worksheets If sh.Name = sname Then sheetsExiste1 = True: Exit For Next End Function ' Function sheetsExiste2(sname As String) As Boolean sheetsExiste2 = Not IsError(Evaluate("='" & sname & "'!A1:z100")) End Function ' Sub test1() t = Timer x = sheetsExiste1("toto") MsgBox x & vbCrLf & Timer - t End Sub ' Sub test2() t = Timer x = sheetsExiste2("toto") MsgBox x & vbCrLf & Timer - t End Sub
je te l'accorde des temps comme ca difficile d'en évaluer la précision
et puis 500 sheets j'ai jamais vu :mouarf:

mais les faits sont là; la boucle est plus gourmande

02/07/2019, 15h36
Arkham46

Citation:

Envoyé par patricktoulon

pour le risque je vois pas trop ou il est a évaluer une formule devant renvoyé un object range (tableau)

Voyais tu le risque sur la première méthode que tu utilisais ?
Bon si je suis un peu retord, je crée une feuille nommée l'avenir...

Pour la performance je n'avais pas regardé mais je m'interrogeais.
C'est sûr que pour ce cas ce n'est pas très important.
On peut également tenter d'accéder à la feuille par son nom et gérer l'erreur, mais ça semble plus lent également que l'evaluate.

En tout cas je ne prendrais personnellement pas de risque pour gagner quelques millisecondes.
En plus ça complique la rédaction de la doc : :aie:

re

Citation:

Voyais tu le risque sur la première méthode que tu utilisais ?

je garde une réserve c'est sur
mais le principe logiquement ne peut créer de surprise
en gros on teste l'existence de la range("A1:z100") dans un sheets: on attend pas de valeur ou calcul ou autres
je précise que j'ai testé avec sheets masqué colonnes masquées ligne masquées
alors a moins que tu me sorte une bidouille de ton chapeau pour supprimer l'existance meme!!!:mouarf: des lignes 1 a 100 ou colonnes A a Z pour moi il n'y a pas de risque

et pour le coup je teste même dans un autre classeur ouvert dans la même instance
Code:

1 2 3 4 5 6 7 8 9 Sub test3() 'MsgBox TypeName(Evaluate("='[Classeur2.xlsx]Feuil1'!A1:A2"))'formule de base exemple 'MsgBox Workbooks(2).Name MsgBox sheetsExiste3(Workbooks(2), "toto")'mettre thisworkbook pour tester sur le classeur de la macro a la place de workbooks(2) End Sub ' Function sheetsExiste3(wbk As Workbook, sname As String) As Boolean sheetsExiste3 = Not IsError(Evaluate("='[" & wbk.Name & "]" & sname & "'!A1:A2")) End Function
tant mieux si tu es retord c'est grâce a cela que tu a mis le doigt sur le problème de la version 1 évaluant une valeur
je n'ai jamais eu de soucis jusque la avec, mais je n'étais pas a l'abri effectivement pourtant je l'utilise depuis longtemps ( je vais finir par croire a la chance)

mes réserves:

a tester avec le veryidden
dans un xla(m) comment se comportera t elle; va elle capter le workbook(2)?

Bonjour Patrick,

Citation:

Envoyé par patricktoulon

pour le risque je vois pas trop ou il est a évaluer une formule devant renvoyé un object range (tableau)

Le problème c'est le mélange des différents types de feuilles : soit la fonction sert à détecter l'existence d'une feuille (Sheet), soit elle sert à détecter l'existence d'une feuille de calcul (Worksheet).
Dans le premier cas (Sheet), aucune des deux fonctions ne convient. Dans le second cas (Worksheet), le problème avec Evaluate, c'est qu'il renvoi Vrai pour un autre type de feuille (Macro XL4).

Pour ma part, je préfère tester directement l'existence (ou la non existence) de la feuille de calcul (même si ça choque certains puristes) :
Code:

1 2 3 4 5 6 7 Function ExisteWorksheet(nomFeuille As String) As Boolean Dim f As Worksheet On Error Resume Next Set f = Worksheets(nomFeuille) On Error GoTo 0 ExisteWorksheet = Not f Is Nothing End Function
Et c'est aussi rapide qu'evaluate et ça fonctionne quel que soit le nom de la feuille (par ex: l'avenir)

02/07/2019, 17h08
patricktoulon

re

re
bonjour Patrice
pour ma part que ce soit en VB(S,A),JS,XML,HTML j'ai toujours appris qu'il fallait éviter de donner des noms au objects avec des caractères particuliers sauf le tiret8
d'autant plus que l'apostrophe est un caractères qu'utilise vba y compris le tiret8 d'ailleurs sauf que celui la est autorise
faut pas pousser mémé dans les orties quand même:ptdr:
02/07/2019, 17h18
Patrice740

Re,

Citation:

Envoyé par patricktoulon

re
bonjour Patrice
pour ma part que ce soit en VB(S,A),JS,XML,HTML j'ai toujours appris qu'il fallait éviter de donner des noms au objects avec des caractères particuliers sauf le tiret8
d'autant plus que l'apostrophe est un caractères qu'utilise vba y compris le tiret8 d'ailleurs sauf que celui la est autorise
faut pas pousser mémé dans les orties quand même:ptdr:

Pour ta part ... mais pas pour le commun des mortels qui consultent ce forum pour trouver une solution.
Autant leur proposer une solution fiable à 100% plutôt que chercher à économiser quelques lignes de code !

PS: Pour ma part, j'utilise tous les caractères autorisés, y compris les accentués et je n'ai jamais de problème à cause de ça, mais je ne conseillerais pas pour autant, à tout un chacun, de le faire.
02/07/2019, 21h26
patricktoulon

re

bonsoir patrice

Citation:

fiable à 100%

ben jusqu' a preuve du contraire elle l'est
ps j'ai testé dans mes xlam ca match aussi
Arkham m'a démontré que la version 1 que l'on trouve partout sur le net ne l'était pas
fait en autant avec la 3
03/07/2019, 01h11
Patrice740
Citation:

Envoyé par patricktoulon

ben jusqu' a preuve du contraire elle l'est
ps j'ai testé dans mes xlam ca match aussi
Arkham m'a démontré que la version 1 que l'on trouve partout sur le net ne l'était pas
fait en autant avec la 3

Je te l'ai déjà dit :
- elle ne fonctionne pas avec une feuille de calcul nommée l'avenir et j'ajouterais Feuille 100% ou Dans 2" , elle donne FAUX lorsque la feuille existe, pourtant les caractères ', ", % sont autorisés dans les noms de feuille ;
- elle ne fonctionne pas pour une feuille de macro MS Excel 4 (elle dit VRAI alors que ce n'est pas une feuille de calcul).
Moi je n'appelle pas ça du 100%, au contraire, c'est une source potentielle de problème !

Et en plus, sheetsExiste3 n'est pas utilisable directement dans une feuille de calcul, comme fonction personnalisée !

re
Ok pour les noms avec "'"

j'en ai une autre pour toi avec ta gestion d'erreur mais sans instancier un sheets(variable F dans ton modèle )
Code:

1 2 3 4 5 6 7 8 9 10 Sub test3() MsgBox sheetsExiste3(ThisWorkbook, "l'avenir") ' peut être utilisé pour tester la présence d'une feuille dans un autre classeur ouvert dans la même instance d'Excel End Sub ' Function sheetsExiste3(wbk As Workbook, sname As String) As Boolean On Error Resume Next sheetsExiste3 = wbk.Sheets(sname).Name = sname On Error GoTo 0 End Function
je vais voir pour les apostrophes dans la formule

edit:
problème résolu pour l'apostrophe

Citation:

elle ne fonctionne pas pour une feuille de macro MS Excel 4 (elle dit VRAI alors que ce n'est pas une feuille de calcul

)

c'est quoi une feuille de macro MS Excel 4?

03/07/2019, 15h21
Patrice740
@Patrick,

C'est effectivement une solution, mais l'idée de départ c'est de détecter la présence d'une feuille de calcul (Worksheet et pas d'un objet représentant une feuille quelconque).
Donc sur ton idée et utilisable dans une feuille de calcul :
Code:

1 2 3 4 5 Function ExisteWorksheet(nomFeuille As String) As Boolean On Error Resume Next ExisteWorksheet = Worksheets(nomFeuille).Name = nomFeuille On Error GoTo 0 End Function
Un feuille de macro MS Excel 4 c'est une feuille dans la quelle on édite le code des macros Excel 4, c'était avant l'apparition du VBE, ça fonctionne toujours mais ces macros ne peuvent pas être signées numériquement. Il y a aussi les feuilles Graphiques qui ne sont pas des Worksheets mais des Charts
03/07/2019, 19h52
patricktoulon

re

bonjour patrice

Citation:

Un feuille de macro MS Excel 4 c'est une feuille dans la quelle on édite le code des macros Excel 4, c'était avant l'apparition du VBE, ça fonctionne toujours mais ces macros ne peuvent pas être signées numériquement. Il y a aussi les feuilles Graphiques qui ne sont pas des Worksheets mais des Charts
Cordialement,

je suis curieux ????
03/07/2019, 20h42
Jean-Philippe André

Salut,

l'idée générale est surtout d'éviter de recréer une roue qui est utilisée partout, et qui fonctionne parfaitement, avec le code de Patricem, plutôt que d'encore une fois faire un gloubi-boulga de code, qui "marche jusqu'à preuve du contraire" :roll:
04/07/2019, 05h00
Transitoire

Bonjour le forum,:)
@ Jean-philippe André, dans votre signature, vous avez écrit:

Citation:

Cycle de vie d'un bon programme :
1/ ca fonctionne 2/ ca s'optimise 3/ ca se refactorise

Qu'entendez vous exactement par refactoriser ? Cela serais gentil d'éclairer ma lanterne.
Cordialement 8-)

Voir 40 message(s) de cette discussion en une page