[Résolu] Novice en Macro, besoin d'aide : Récupérer la couleur du texte d'une cellule

macmag

XLDnaute Nouveau
Bonjour à tous,

Novice en macro, je souhaiterais que quelqu'un m'aide pour le problème suivant. Il s'agit d'un classeur pour gérer du personnel. Sur les 3 premières feuilles, figure le planning général affichant les horaires de tout les personnel (environ 40 agents)..(2 semaines par feuille). Chaque horaire est écrit d'une couleur en fonction du poste où l'agent est affecté. Ensuite, la feuille 4 reprend l'horaire (mois entier) du 1er agent, la feuille 5 l'horaire du 2ème agent, ainsi de suite ... Je ne connais que depuis peu les macros, donc pour la plupart des cellules des plannings individuels, j'ai utilisé des formules telles que =Feuil1!W32. Autant vous dire que ça m'a pris un temps fou ! Bref ... Maintenant, ce que je voudrais c'est que la couleur de l'horaire apparaisse aussi sur le planning individuel de l'agent, car une couleur correspond à un poste.

En espérant avoir été claire ...
Cordialement,

Macmag
 

job75

XLDnaute Barbatruc
Re : Novice en Macro, besoin d'aide : Récupérer la couleur du texte d'une cellule

Bonsoir macmag,

Voici les nouvelles macros avec 3 compléments :

1) Regroupement des macros Colore et RenommeFeuilles en une seule.

2) Introduction de la fonction Epure.

Il existe en effet des caractères interdits, tant pour les noms des feuilles que pour les noms des classeurs.

Cette fonction les remplace par # (sans ça, pour les feuilles, la macro boucle indéfiniment !!).

3) Création de fichiers à partir des feuilles renommées, comme vous l'avez demandé plus haut.

Donc à copier/coller en bloc dans un Module :

Code:
Sub ColoreCellules_RenommeFeuilles()
Dim w As Worksheet, cel As Range, t$, i&
Application.ScreenUpdating = False
For Each w In Worksheets
  '---coloration des cellules avec liaison---
  On Error Resume Next
  For Each cel In w.UsedRange
    t = Mid(cel.Formula, 2)
    cel.Interior.ColorIndex = Range(t).Interior.ColorIndex 'couleur de fond
    cel.Font.ColorIndex = Range(t).Font.ColorIndex 'couleur de police
  Next
  '---renommage provisoire de la feuille
  t = Mid(w.[C3].Formula, 2)
  On Error Resume Next
  t = Range(t).Address
  If Err = 0 Then
    i = i + 1
    w.Name = Chr(1) & i
  End If
Next
'---renommage définitif---
For Each w In Worksheets
  If w.Name Like Chr(1) & "*" Then
    i = 0
    t = ""
1   On Error Resume Next
    w.Name = Epure(Left(w.[C3], 31 - Len(t))) & t
    If Err Then
      i = i + 1
      t = "(" & i & ")"
      GoTo 1
    End If
  End If
Next
'---création des fichiers (facultatif ici)---
CreationFichier
End Sub

Sub CreationFichier()
Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier existe déjà
n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
Application.SheetsInNewWorkbook = 1
chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
For Each w In Worksheets
  t = Mid(w.[C3].Formula, 2)
  On Error Resume Next
  t = Range(t).Address
  If Err = 0 Then
    Set Wb = Workbooks.Add 'nouveau document
    w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
    Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
    Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
    Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
    Wb.Close
  End If
Next
Application.SheetsInNewWorkbook = n
End Sub

Function Epure$(t$)
Dim interdit$, i As Byte
interdit = ":""/\<>?*[]|" 'caractères interdits dans les noms des feuilles OU des classeurs
For i = 1 To 11
  t = Replace(t, Mid(interdit, i, 1), "#")
Next
Epure = t
End Function

Edit : manquait, pour les noms de classeurs, le caractère interdit | (en bas à droite du 6).

A+
 
Dernière édition:

macmag

XLDnaute Nouveau
Re : Novice en Macro, besoin d'aide : Récupérer la couleur du texte d'une cellule

Bonsoir Job 75,

Re-mes respects ! Je crois pouvoir dire que vous avez répondu à toutes mes attentes.
Mille mercis.
Egalement aux autres participants.

Cdt
Macmag

PS : Dîtes ... vous tapez tout cela à la main mot à mot ?:eek:
 

job75

XLDnaute Barbatruc
Re : Novice en Macro, besoin d'aide : Récupérer la couleur du texte d'une cellule

Bonjour macmag, le forum,

Heureux de vous avoir donné satisfaction.

PS : Dîtes ... vous tapez tout cela à la main mot à mot ?:eek:

Je suis souvent aidé par ma boule de cristal, mais la pauvre n'a pas de mains, snif :(

Quant à mon clavier, j'ai bien essayé de le dresser à se débrouiller tout seul, mais il est assez borné.

A+
 

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 970
Membres
101 852
dernier inscrit
dthi16088