[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

Bonjour macmag, bienvenue sur XLD,

Si j'ai bien compris, vous voulez qu'une cellule comportant une formule de liaison prenne la couleur de la cellule dont elle dépend.

Alors exécutez ce code :

Code:
Sub Colore()
Dim cel As Range, ad As String
On Error Resume Next 'au cas ou ad n'est pas l'adresse d'une cellule
For Each cel In ActiveSheet.UsedRange
  If cel.Formula Like "=Feuil1!*" Then 'nom de la feuille source à adapter
    ad = Mid(cel.Formula, 2, 99) 
    cel.Interior.ColorIndex = Range(ad).Interior.ColorIndex
  End If
Next
End Sub
La macro est à mettre où vous voulez : Module standard ou code de la feuille.

A+
 
Dernière édition:

macmag

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

Effectivement, Job, je crois que vous avez zappé "novice en macro" ..... Mais je vais quand même essayer. Il suffit de faire un copier coller du code ?
 

macmag

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

Merci Job pour ce début de réponse.
En effet, cela fonctionne pour la feuille 1 uniquement et pour la couleur de remplissage uniquement.
Or les données sources peuvent être sur la feuille 1 ou 2 ou 3. Et il faut que la couleur de police soit également copiée.
 

job75

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

Bonjour macmag, C-C :) le forum,

En effet, cela fonctionne (...)
Très bien pour une novice :)

Essayez donc maintenant :

Code:
Sub Colore()
Dim cel As Range, ad As String
On Error Resume Next 'au cas ou ad n'est pas l'adresse d'une cellule
For Each cel In ActiveSheet.UsedRange
  If cel.Formula Like "=Feuil*!*" Then 'noms des feuilles sources à adapter
    ad = Mid(cel.Formula, 2, 99) 
    cel.Interior.ColorIndex = Range(ad).Interior.ColorIndex 'couleur de fond
    cel.Font.ColorIndex = Range(ad).Font.ColorIndex 'couleur de police
  End If
Next
End Sub
A+
 

job75

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

Re,

D'ailleurs si toute cellule source doit être copiée, écrire plus simplement :

Code:
Sub Colore()
Dim cel As Range, ad As String
On Error Resume Next 'au cas ou ad n'est pas l'adresse d'une cellule
For Each cel In ActiveSheet.UsedRange
  ad = Mid(cel.Formula, 2, 99) 
  cel.Interior.ColorIndex = Range(ad).Interior.ColorIndex 'couleur de fond
  cel.Font.ColorIndex = Range(ad).Font.ColorIndex 'couleur de police
Next
End Sub
A+
 

macmag

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

C'es super ! Merci Job, ça marche. Faudrait que j'apprenne à décoder de façon à pouvoir les faire moi-même.
J'ai 2 autres questions SVP:
- la feuille peut -elle prendre automatiquement le nom de l'agent ? Par exemple, la 4ème feuille peut-elle prendre l'info contenue dans la cellule source Feuil1!A3 ?
- est-il possible de faire en sorte que chaque planning individuel, c-a-d chaque feuille à partir de la feuille 4, constitue un fichier séparé ? (un classeur où il n'y aura que cette feuille-là)
 

Yaloo

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

Bonjour macmag, le forum,

Essaie ceci :

Code:
Sub Renome()
On Error GoTo msg
    Dim Feuille As Worksheet
    For Each Feuille In Worksheets
    Feuille.Name = Feuille.Range("A3").Value
    Next Feuille
Exit Sub
msg:     MsgBox "la feuille ne peut pas être renommée"
End Sub
A+
 

macmag

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

Bonjour Yaloo,
Merci pour ta réponse. J'ai essayé le code : J'ai le message "la feuille ne peut pas etre renomée". Toutefois, la feuil 1 prend le nom du 1er agent.
 

macmag

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

En fait, comme le nom de l'agent apparait sur chaque feuille en C3, il faudrait que le code dise " renome la feuille avec le nom qui est en C3".
 

Gorfael

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

Salut macmag et le forum
renome la feuille avec le nom qui est en C3
en m'inspirant de la macro de Yaloo, on aurait :
Code:
Sub Renomme()
On Error GoTo Err_1
Dim F As Worksheet
For Each F In ThisWorkbook.Sheets
    If F.Range("C3") <> "" Then F.Name = F.Range("C3")
Next F
Exit Sub

Err_1:
If Err.Number = 1004 Then
    MsgBox "feuille de nom " & F.Range("C3") & " existe déjà", vbInformation, "Erreur de renommage"
    F.Activate
    [C3].Activate
Else
    MsgBox Err.Description, vbCritical, "Erreur n°" & Err.Number
End If
End Sub
Pour chaque feuille du classeur contenant la macro
si sa cellule C3 n'est pas vide, remplacer le nom de la feuille par C3

en cas d'erreur Excel :
si le numéro d'erreur est 1004, boîte de dialogue " le nom existe déjà", activer C3 de la feuille en cause,
sinon afficher le descriptif et le numéro de l'erreur.

A+

Edit : Voilà ce que c'est de corriger une macro sans la tester, désolé : Comme on n'a pas beaucoup d'indication, j'ai voulu limiter les feuilles à celle du classeur contenant la macro. J'ai corrigé (et testé) ma macro :
Dim F As Worksheet => F est une variable feuille de calcul
For Each F In ThisWorkbook.Sheets => Pour chaque Feuille de la collection de feuille (sheets) de ce classeur (ThisWorkBook)
 
Dernière édition:

macmag

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

Bjr Gorfael,
Merci de te pencher sur mon cas.
J'ai essayé le code et j'ai le message suivant : erreur de compilation: type défini par l'utilisateur non défini. "F As ThisWorkbook.Sheets" est surligné.
 

macmag

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

Descriptif de l'erreur

Type défini par l'utilisateur non défini
Voir aussi Particularités

Vous pouvez créer vos propres types de données dans Visual Basic, mais ils doivent d'abord être définis dans une instruction Type...End Type ou dans une bibliothèque d'objets ou dans une bibliothèque de types correctement enregistrée. Causes et solutions de cette erreur :

Vous avez tenté de déclarer une variable ou un argument avec un type de données non défini ou vous avez spécifié une classe ou un nom d'objet inconnu.
Utilisez l'instruction Type dans un module pour définir un nouveau type de données. Si vous tentez de créer une référence à une classe, celle-ci doit être visible pour le projet. Si vous faites référence à une classe dans votre programme, vous devez avoir un module de classe du nom spécifié dans votre projet. Vérifiez l'orthographe du nom du type ou du nom de l'objet.

Le type à déclarer se trouve dans un autre module, mais a été déclaré Private.
Placez la définition du type dans un module standard où il peut être Public.

Le type est correct, mais la bibliothèque d'objets ou la bibliothèque de types dans laquelle il est défini n'est pas enregistrée dans Visual Basic.
Affichez la boîte de dialogue Références, puis sélectionnez la bibliothèque d'objets ou la bibliothèque de types appropriée. Par exemple, si vous ne cochez pas la ligne concernant les Objets d'accès aux données dans la boîte de dialogue Références, les types Database, Recordset et TableDef ne sont pas reconnus et les références à ceux-ci dans votre code causent cette erreur.

Pour plus d'informations, sélectionnez l'élément en question et appuyez sur F1 (sous Windows) ou AIDE (sur Macintosh).
 

job75

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

Bonjour macmag, le fil,

Eh bien macmag pour une novice vous faites fort.

Le problème en effet n'est pas vraiment simple.

Cette macro nomme provisoirement les feuilles qui ont une formule de liaison en C3.

Ensuite elle les nomme définitivement en ajoutant un indice s'il y a doublon :

Code:
Sub RenommeFeuilles()
Dim w As Worksheet, txt As String, i As Long
Application.ScreenUpdating = False
'---renommage provisoire si formule de liaison en C3---
For Each w In Worksheets
  txt = Mid(w.[C3].Formula, 2, 99)
  On Error Resume Next
  txt = Range(txt).Address
  If Err = 0 Then
    i = i + 1
    w.Name = Chr(1) & i
  End If
Next
'---renommage définitif avec indice si doublon---
For Each w In Worksheets
  If w.Name Like Chr(1) & "*" Then
    i = 0
    txt = ""
1   On Error Resume Next
    w.Name = Left(w.[C3], 31 - Len(txt)) & txt
    If Err Then
      i = i + 1
      txt = "(" & i & ")"
      GoTo 1
    End If
  End If
Next
End Sub
Ne pas oublier que le nom d'une feuille ne peut dépasser 31 caractères...

A+
 

macmag

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

Bjr Job 75, bjr tt le monde

Job 75, mes respects ! Ca fonctionne impec. Merci.
Je ne sais pas ce qu'est un indice, ni un doublon ...

Sans vouloir abuser ...
La macro "renomme feuilles" s'est appliquée automatiquement à toutes les feuilles (sauf les 3 premières bien sûr) alors que pour la macro "colore", j'ai du faire une feuille à une.
Peut-on faire en sorte que la macro "colore" s'applique à toutes les feuilles en même temps ? Et peut-on réunir ces 2 macros en une seule ?

A+ :)
 

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+
 

macmag

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

Bonjour Job, le forum,

Juste pour dire ... mdr !

Merci encore.

A +
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas