Discussion :

[guerzan22]

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 :

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

[Kimy_Ire]

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

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

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
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 !

N'hésite pas à revenir vers moi !

Cordialement,
Kimy

[PMO2017]

Bonjour,

Essayez avec votre code transformé

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

[guerzan22]

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 :

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

[PMO2017]

Bonjour,

Essayez ce code

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

[guerzan22]

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