Discussion :

[Flow1995]

Bonjour,

J’aimerais détecté dans une plage de cellule (A1:A31) les cellules ayant une couleur grise. Cette couleur est donnée par une mise en forme conditionnelle.
Et pour chaque cellule grise, créer un nouvel onglet de la même couleur et avec le texte la cellule.
Les cellules grises changent d'endroit en fonction du mois que l'on choisi.

Grace à l’enregistreur de macro, j’ai obtenu un nombre qui correspond à ma couleur de cellule :
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736

J'arrive à créer les nouveaux onglets pour chaque jour du calendrier mais pas à griser les cellules du week-end.

Ma 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
 
Sub Ajouter_Feuilles()
Dim J As Long
Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
   For J = 1 To 31
    If Not FeuilleExiste(Ws.Range("A" & J).Value) And Len(Ws.Range("A" & J).Value) > 1 Then
      Sheets("Rapport").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)
    End If
  Next J
  Ws.Select
End Sub
 
'Si l'onglet  existe déjà, il n'est pas créé
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

Auriez-vous une idée ?

Merci d'avance

Florian

[halaster08]

J’aimerais détecté dans une plage de cellule (A1:A31) les cellules ayant une couleur grise. Cette couleur est donnée par une mise en forme conditionnelle.
Et pour chaque cellule grise, créer un nouvel onglet de la même couleur et avec le texte la cellule.

Bonjour,

Plutôt que d'utiliser la couleur venant d'une MFC, autant utiliser la logique qu'il y a derrière la MFC

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Ajouter_Feuilles()
Dim J As Long
Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
   For J = 1 To 31
    If Not FeuilleExiste(Ws.Range("A" & J).Value) And Len(Ws.Range("A" & J).Value) > 1 and "la condition de la MFC" Then
      Sheets("Rapport").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)
    End If
  Next J
  Ws.Select
End Sub

[Flow1995]

Merci de ta réponse halaster08

A la place de travailler sur la détection de couleur (que je n'arrive pas parce que la couleur obtenue par mise en forme conditionnelle d'une cellule reste inchangée).
Je cherche donc à utiliser la même formule que dans la mise en forme conditionnelle pour définir la couleur WeekDay(Date,PremierJourSemaine).

Je me suis lancer dans le code, mais j'ai une erreur sur ma ligne :
--> If Wsfunction.Weekday((Ws.Range("A" & J).Value), 2) > 5 Then

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
 
Sub Ajouter_Feuilles()
Dim J As Long
Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
   For J = 1 To 31
    If Not FeuilleExiste(Ws.Range("A" & J).Value) And Len(Ws.Range("A" & J).Value) > 1 Then
      If Wsfunction.Weekday((Ws.Range("A" & J).Value), 2) > 5 Then
      Sheets("Rapport").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)
      ActiveSheet.Tab.Color = RGB(127, 127, 127)
      Else
      Sheets("Rapport").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)
      End If
    End If
  Next J
  Ws.Select
End Sub
 
'Si l'onglet  existe déjà, il n'est pas créé
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

Je n'arrive pas à savoir quoi changer.

Merci d'avance

[halaster08]

Tu es sur que Wsfunction existe? Moi non, essaye avec worksheetfunction

[Flow1995]

En effet, ca n'existe pas.
J'en ai profité pour raccourcir le 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
Sub Ajouter_Feuilles()
Dim J As Long
Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
   For J = 1 To 31
    If Not FeuilleExiste(Ws.Range("A" & J).Value) And Len(Ws.Range("A" & J).Value) > 1 Then
      Sheets("Rapport").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)
      If Weekday((Ws.Range("A" & J).Value), 2) > 5 Then ActiveSheet.Tab.Color = RGB(127, 127, 127)
    End If
  Next J
  Ws.Select
End Sub
 
'Si l'onglet  existe déjà, il n'est pas créé
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

Mais toujours une erreur sur ma ligne :
If Weekday((Ws.Range("A" & J).Value), 2) > 5 Then ActiveSheet.Tab.Color = RGB(127, 127, 127)

[halaster08]

quelle erreur ?
quelle est la valeur de J au moment de l'erreur ? quelle est la valeur de Ws.Range("A" & J).Value ?

[Theze]

Bonjour,

Dans ta colonne A, as-tu bien des dates valides ? Car la fonction WeekDay() attend entre autre, un numéro de série, aujourd'hui le numéro de série est 43326 qui formaté donne le 14/08/2018

[Flow1995]

Bonjour,

J'ai des dates de la forme : jj.mm.aaaa
Est-ce que c'est un format valide ?

[Theze]

Re,

Avec le point je ne suis pas sûr !
Le message d'erreur n'est il pas "Incompatibilité de type" (erreur 13) ?