Impossible de récupérer le CodeName

Version imprimable

Bonjour
Je suis débutant en programmation et je voudrais un outil Excel me permettant d’ajouter des feuilles dans un classeur à partir d’une liste de noms en cliquant sur un bouton. Cela fonctionne très bien lorsque l’éditeur vba est ouvert sinon, j’obtiens le message suivant « l’indice n’appartient pas à la sélection ! ». Après plusieurs heures de recherche, je me rends compte que je ne récupère pas le CodeName des feuilles nouvellement créées (affichage dans une MsgBox). Par contre, aucun souci lorsque l’éditeur vba est ouvert.

Je vous remercie beaucoup par avance de l’attention que vous porterez à mon message.

Voici le code de la macro :
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 Sub Ajout_eleves() Dim nb_eleves As Integer Dim liste_eleves() As String Dim Nom As String Dim prenom As String Dim eleve As String Dim Cname As String nb_eleves = WorksheetFunction.CountA(Range("A:A")) - 1 ReDim liste_eleves(nb_eleves, 3) For i = 1 To nb_eleves Nom = Cells(i + 1, 1).Value liste_eleves(i, 1) = Nom prenom = Cells(i + 1, 2).Value liste_eleves(i, 2) = prenom eleve = Nom + " " + prenom Sheets.Add(, ActiveSheet).Name = eleve Sheets(eleve).Range("B1").Value = eleve Cname = Worksheets(eleve).CodeName MsgBox Worksheets(eleve).CodeName liste_eleves(i, 3) = Cname Call competences.copie_competences(eleve) Call competences.EcrireCode(Cname) Next End Sub

Bonjour guerzan22,

Je n'ai jamais utilisé la propriété .CodeName de Worksheet. Quel est ton but ?
J'imagine que tu cherches à passer en paramètre ta feuille lorsque tu appelles Call competences.EcrireCode(Cname). :koi:

Je te propose de t'orienter vers quelque chose de ce style, plutôt :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub add_wksh() Dim oWksh As Worksheet Set oWksh = Worksheets.Add(After:=Worksheets(Worksheets.Count)) oWksh.Name = "test_creation" Call ecrire_feuille(oWksh) End Sub Function ecrire_feuille(ma_feuille As Worksheet) With ma_feuille .Range("A1") = "test" End With End Function
Voila ! :ccool:

N'hésite pas à revenir vers moi !

Cordialement,
Kimy

Bonjour,

Essayez avec votre code transformé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Ajout_eleves()
Dim S As Worksheet
Dim nb_eleves As Integer
Dim liste_eleves() As String
Dim i As Integer
'---
nb_eleves = WorksheetFunction.CountA(Range("A:A")) - 1
ReDim liste_eleves(nb_eleves, 3)
'--- Les donnée ---
For i = 1 To nb_eleves
  liste_eleves(i, 1) = Cells(i + 1, 1)
  liste_eleves(i, 2) = Cells(i + 1, 2)
  liste_eleves(i, 3) = liste_eleves(i, 1) & " " & liste_eleves(i, 2)
Next i
'--- Création des feuilles ---
For i = 1 To nb_eleves
  Set S = Sheets.Add(, ActiveSheet)
  S.Name = liste_eleves(i, 3)
  S.[B1] = liste_eleves(i, 3)
Next i
End Sub

VBComponents

Bonjour

Merci beaucoup pour vos réponses. J’ai retravaillé ma macro mais malheureusement, j’ai toujours le même problème, à savoir une exécution normale lorsque l’éditeur vba est ouvert et sinon, le message d’erreur « l’indice n’appartient pas à la sélection ». Dans chaque feuille nouvellement crée, je copie également du code et j’utilise VBComponents. Ne serait-ce pas cela le problème ?

Merci encore beaucoup pour votre aide.

Voici le code de la fonction utilisée :

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
Function EcrireCode(S As Worksheet)
    Dim i, LeCode(1 To 31)
    Dim NomClasseur, guil As String
    Dim Wb As Workbook
 
        NomClasseur = ActiveWorkbook.Name
        guil = """"
 
 
        LeCode(1) = "Sub Worksheet_Change(ByVal Target As Range)"
        LeCode(2) = "Dim valeur As String"
        LeCode(3) = "valeur = ActiveCell.Value"
        LeCode(4) = "Select Case valeur"
        LeCode(5) = "Case Is = " & guil & "0" & guil
        LeCode(6) = "Target.Interior.Color = RGB(245, 245, 220)"
        LeCode(7) = "ActiveCell.Borders.Weight = 2"
        LeCode(8) = "ActiveCell.Font.Bold = True"
        LeCode(9) = "ActiveCell.Font.Size = 12"
        LeCode(10) = "Case Is = " & guil & "E" & guil
        LeCode(11) = "Target.Interior.Color = RGB(0, 128, 224)"
        LeCode(12) = "ActiveCell.Borders.Weight = 2"
        LeCode(13) = "ActiveCell.Font.Bold = True"
        LeCode(14) = "ActiveCell.Font.Size = 12"
        LeCode(15) = "Case Is = " & guil & "A" & guil
        LeCode(16) = "Target.Interior.Color = RGB(0, 224, 0)"
        LeCode(17) = "ActiveCell.Borders.Weight = 2"
        LeCode(18) = "ActiveCell.Font.Bold = True"
        LeCode(19) = "ActiveCell.Font.Size = 12"
        LeCode(20) = "Case Is = " & guil & "VA" & guil
        LeCode(21) = "Target.Interior.Color = RGB(255, 160, 0)"
        LeCode(22) = "ActiveCell.Borders.Weight = 2"
        LeCode(23) = "ActiveCell.Font.Bold = True"
        LeCode(24) = "ActiveCell.Font.Size = 12"
        LeCode(25) = "Case Is = " & guil & "NA" & guil
        LeCode(26) = "Target.Interior.Color = RGB(255, 0, 0)"
        LeCode(27) = "ActiveCell.Borders.Weight = 2"
        LeCode(28) = "ActiveCell.Font.Bold = True"
        LeCode(29) = "ActiveCell.Font.Size = 12"
        LeCode(30) = "End Select"
        LeCode(31) = "End sub"
 
        Set Wb = Workbooks(NomClasseur)
 
            For i = 1 To 31
            Wb.VBProject.VBComponents(S.CodeName).CodeModule.InsertLines i, LeCode(i)
            Next i
 
End Function

Bonjour,

Essayez ce code

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
Sub Ajout_eleves()
Dim S As Worksheet
Dim nb_eleves As Integer
Dim liste_eleves() As String
Dim i As Integer
'---
nb_eleves = WorksheetFunction.CountA(Range("A:A")) - 1
ReDim liste_eleves(nb_eleves, 3)
'--- Les donnée ---
For i = 1 To nb_eleves
  liste_eleves(i, 1) = Cells(i + 1, 1)
  liste_eleves(i, 2) = Cells(i + 1, 2)
  liste_eleves(i, 3) = liste_eleves(i, 1) & " " & liste_eleves(i, 2)
Next i
'--- Création des feuilles ---
For i = 1 To nb_eleves
  Set S = Sheets.Add(, ActiveSheet)
  S.Name = liste_eleves(i, 3)
  S.[B1] = liste_eleves(i, 3)
 
  Call EcrireCode(S)  '///ajout
 
Next i
End Sub
 
 
Sub EcrireCode(S As Worksheet)  ' Sub et non Function car il n'y a pas de valeur de retour
Dim S2 As Worksheet
Dim guil$
Dim A$
Dim LeCodeName$
'--- Chaîne du code ---
guil = """"
A$ = A$ & vbLf & "Sub Worksheet_Change(ByVal Target As Range)"
A$ = A$ & vbLf & "Select Case Target"
A$ = A$ & vbLf & "Case Is = " & guil & "0" & guil
A$ = A$ & vbLf & "Target.Interior.Color = RGB(245, 245, 220)"
A$ = A$ & vbLf & "Case Is = " & guil & "E" & guil
A$ = A$ & vbLf & "Target.Interior.Color = RGB(0, 128, 224)"
A$ = A$ & vbLf & "Case Is = " & guil & "A" & guil
A$ = A$ & vbLf & "Target.Interior.Color = RGB(0, 224, 0)"
A$ = A$ & vbLf & "Case Is = " & guil & "VA" & guil
A$ = A$ & vbLf & "Target.Interior.Color = RGB(255, 160, 0)"
A$ = A$ & vbLf & "Case Is = " & guil & "NA" & guil
A$ = A$ & vbLf & "Target.Interior.Color = RGB(255, 0, 0)"
A$ = A$ & vbLf & "End Select"
A$ = A$ & vbLf & "Target.Borders.Weight = 2"
A$ = A$ & vbLf & "Target.Font.Bold = True"
A$ = A$ & vbLf & "Target.Font.Size = 12"
A$ = A$ & vbLf & "End sub"
'--- Quel est le CodeName ---
For Each S2 In ThisWorkbook.Worksheets
  If S.Name = S2.Name Then
    LeCodeName$ = S2.CodeName
    Exit For
  End If
Next S2
'--- Ajout du code ---
ThisWorkbook.VBProject.VBComponents(LeCodeName$).CodeModule.AddFromString A$
End Sub

**********
Plutôt que d'écrire un code événementiel pour chaque feuille créée, il serait préférable de n'en écrire qu'une seule dans ThisWorkbook "Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)".
On exclurait les feuilles qui ne seront pas concernées et la Sub agirait sur toutes les autres.

23/09/2015, 18h43
guerzan22

Pb résolu.

Merci beaucoup pour vos remarques. Au lieu de recopier du code sur les nouvelles pages, j'ai géré cela avec l'évenement Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range). Je n'ai plus de problème à l'exécution. Je vous remercie beaucoup pour votre aide et je vais pouvoir maintenant utiliser mon outil et le partager avec mes collègues.
Bonne soirée