copier couleur de cellule

[pat17]

Bonjour à tous
Est il possible de récupérer la couleur de la cellule J3 dans (FeuilleDeTravail) Afin de mettre à jour la feuille (Salle de conférence)dans le planning lorsque je clique sur le bouton (recherche automatique) et que je récupère le nom de l'utilisateur.
J'espère être assez clair
Merci pour votre aide

Ci joint fichier
Cijoint.fr - Service gratuit de dépôt de fichiers

 

[macsscam]

Re : copier couleur de cellule

Bonjour pat17, le forum,

Si j'ai bien compris, ton but est de mettre dans l'onglet "Salle de conférence" (si c'est celle-ci qui est réservée) la même couleur pour la réservation que celle de l'onglet "Feuille de Travail". En l'occurrence "J3", si c'est QSE qui réserve.

Je ne suis pas rentré dans tout le code mais une solution (si j'ai bien compris) consiste à récupérer la couleur au moment de la récupération de l'utilisateur et de la réutiliser après lors de l'ajout de la réservation :

Dim couleur as Integer

'Récupération de la couleur de l'utilisateur (remplacer le Range par les variables utilisées dans le programme, ce sera plus propre)
couleur = Range("FeuilleDeTravail!J3").Interior.ColorIndex

'Code de recherche et d'ajout de la réservation

'Ajout de la couleur sur la plage de réservation (remplacer le Range par la bonne variable
Range("Plagedereservation").Interior.ColorIndex = couleur

Si cela ne suffit pas, n'hésite pas à redemander, je prendrai un peu plus le temps de me pencher sur le code,

Bon courage,

--
macsscam

 

[Odesta]

Re : copier couleur de cellule

BOnjour à tous les deux

J'ai réfléchi aussi de mon coté :

Sous chaque lancement de "Contour", il suffirait de mettre "Couleur" qui aurait ce code :

Sub Couleur()

    Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Interior.ColorIndex = Worksheets("FeuilleDeTravail").Range("J3").Interior.ColorIndex
    ' Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).FormatConditions.Delete

End Sub

J'ai mis en commentaire la deuxième ligne, car elle n'est pas compatible avec le bouton 'annuler réservation', puisqu'elle supprime les MFC, il faudrait donc, dans le code de l'annulation de résa, les remettre (et je ne m'y suis pas penché).

Sinon, bravo Pat17, le projet avance bien !

Cordialement
Olivier

 

[pat17]

Re : copier couleur de cellule

Merci macsscam pour ta réponse et merci aussi à odesta pour ces encouragements.

Pour odesta
J'ai essayé ce que vous avez préconisé mais j'ai une erreur de compilation avec nom ambigu voir fichier joint.

Pour macsscam
Tu as bien cerné ce que je souhaites mais je ne sais pas ou placer le code peux tu me le préciser.

Amicalement à vous deux

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[Odesta]

Re : copier couleur de cellule

J'ai essayé ce que vous avez préconisé mais j'ai une erreur de compilation avec nom ambigu voir fichier joint.

Il faut mettre sous chaque Contour : uniquement Couleur

et ensuite, il faut rajouter une seule fois la procédure Sub Couleur .... End Sub.

Ici, vous avez rajouter plusieurs fois la sub, à l'intérieur de la sub principale, le pauvre programme ne retrouve plus ses petits !

 

[pat17]

Re : copier couleur de cellule

J'ai fais les modifs mais j'ai toujours la même erreur de compilation
ci joint le code car je n'arrive pas à déposer le fichier modifié

Private Sub ListBoxVh_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

If ComboNomUtilisateur.ListIndex = -1 Then
InsérerNomDansLaBase
End If

With Worksheets(ListBoxVh.Value)
If CDate(ComboDateDébut) = CDate(ComboDateFin) Then
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
For compteurDeColonne = ColonneDébut To ColonneFin
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
Couleur

ElseIf CDate(ComboDateFin) = CDate(ComboDateDébut) + 1 Then
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
For compteurDeColonne = ColonneDébut To 25
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
Sub Couleur()
Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Interior.ColorIndex = Worksheets("FeuilleDeTravail").Range("J3").Interior.ColorIndex
End Sub

For compteurDeColonne = 2 To ColonneFin - 1
.Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
Contour
Couleur


ElseIf CDate(ComboDateFin) > CDate(ComboDateDébut) + 1 Then

For compteurDeColonne = ColonneDébut To 25
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
Couleur

For CompteurDeLigne = 1 To (CDate(ComboDateFin) - CDate(ComboDateDébut) - 1)
For compteurDeColonne = 2 To 25
.Cells(LigneDeDateDébut + CompteurDeLigne, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDateDébut + CompteurDeLigne, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut + CompteurDeLigne, 2), .Cells(LigneDeDateDébut + CompteurDeLigne, 25)).Address
Contour
Couleur

Next
.Cells(LigneDeDateDébut + 1, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut + 1, 2), .Cells(LigneDeDateDébut + 1, 25)).Address
Contour
Couleur

For compteurDeColonne = 2 To ColonneFin
.Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
Contour
Couleur

End If
End With
Unload Me
MsgBox " Réservation effectuée"
End Sub
Sub Couleur()
Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Interior.ColorIndex = Worksheets("FeuilleDeTravail").Range("J3").Interior.ColorIndex
End Sub

 

[Odesta]

Re : copier couleur de cellule

Il en reste un ! ^^

Private Sub ListBoxVh_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
           
        If ComboNomUtilisateur.ListIndex = -1 Then
            InsérerNomDansLaBase
        End If
           
           With Worksheets(ListBoxVh.Value)
            If CDate(ComboDateDébut) = CDate(ComboDateFin) Then
                .Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
                For compteurDeColonne = ColonneDébut To ColonneFin
                    .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
                Next
                CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
                Contour
                Couleur
                
            ElseIf CDate(ComboDateFin) = CDate(ComboDateDébut) + 1 Then
                    .Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
                For compteurDeColonne = ColonneDébut To 25
                       .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
                Next
                CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
                Contour
                [COLOR="Red"]Sub Couleur()
                Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Interior.ColorIndex = Worksheets("FeuilleDeTravail").Range("J3").Interior.ColorIndex
                End Sub[/COLOR]                
                For compteurDeColonne = 2 To ColonneFin - 1
                       .Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
                Next
                .Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
                CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
                Contour
                Couleur
                
                
            ElseIf CDate(ComboDateFin) > CDate(ComboDateDébut) + 1 Then
                
                For compteurDeColonne = ColonneDébut To 25
                        .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
                Next
                .Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
                CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
                Contour
                Couleur
                
                For CompteurDeLigne = 1 To (CDate(ComboDateFin) - CDate(ComboDateDébut) - 1)
                    For compteurDeColonne = 2 To 25
                            .Cells(LigneDeDateDébut + CompteurDeLigne, compteurDeColonne).Interior.ColorIndex = 35
                Next
                .Cells(LigneDeDateDébut + CompteurDeLigne, 2) = ComboNomUtilisateur
                CelluleAEntourer = Range(.Cells(LigneDeDateDébut + CompteurDeLigne, 2), .Cells(LigneDeDateDébut + CompteurDeLigne, 25)).Address
                Contour
                Couleur
                                
                Next
                .Cells(LigneDeDateDébut + 1, 2) = ComboNomUtilisateur
                CelluleAEntourer = Range(.Cells(LigneDeDateDébut + 1, 2), .Cells(LigneDeDateDébut + 1, 25)).Address
                Contour
                Couleur
                                
                For compteurDeColonne = 2 To ColonneFin
                        .Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
                Next
                .Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
                CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
                Contour
                Couleur
                               
           End If
        End With
        Unload Me
        MsgBox " Réservation effectuée"
End Sub
Sub Couleur()
    Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Interior.ColorIndex = Worksheets("FeuilleDeTravail").Range("J3").Interior.ColorIndex
End Sub

 

[pat17]

Re : copier couleur de cellule

désolé mais je n'avais pas vu qu'il en restait un et maintenant ca fonctionne.
Par contre comment faire pour adapter la couleur en fonction de la personne sélectionné.
QSE=rose DET=jaune BCM=vert etc

et merci encore

 

[Odesta]

Re : copier couleur de cellule

Alors, ce n'est pas le but recherché ici :
Est il possible de récupérer la couleur de la cellule J3 dans (FeuilleDeTravail)

Mais on peut y réfléchir !

il va falloir travailler sur le récupération de la couleur en même temps que la récupération du nom de la personne. Je regarde.

Pouvez-vous réfléchir à votre besoin concernant les mise en forme conditionnelles ? car les WE et jour férié : pas de couleur !

 

[pat17]

Re : copier couleur de cellule

bizarre car chez moi la MFC fonctionne

 

[Odesta]

Re : copier couleur de cellule

Oui... mais lorsqu'un utilisateur va réserver une salle le dimanche, la couleur va rester Orange, et ne changera pas avec la couleur de la personne. Cela dit, cela ne vous gène peut-être pas.

 

[macsscam]

Re : copier couleur de cellule

Bonjour,

Je me permets quelques remarques sur le code :
- tu peux créer deux Sub chapeau (une qui désactive les évenements et l'affichage et une qui les active), tu les appelles respectivement au début et à la fin, cela évite d'avoir de multiples appels au sein de tes procédures
- tu devrais commenter ton code (même si cela semble évident quand tu l'écris, ce sera plus facile à reprendre (et à partager))


Et pour ta question, en reprenant la proposition d'Olivier (qui était la solution puisqu'il faut modifier la Sub Contour), que j'ai adaptée pour chercher dynamiquement le nom de l'utilisateur :

Sub Contour()
Dim RUser As Range

    Set RUser = Sheets("FeuilleDeTravail").Columns("J:J").Find(What:=ComboNomUtilisateur, After:=Sheets("FeuilleDeTravail").Range("J1"), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
    With Worksheets(ListBoxVh.Value).Range(CelluleAEntourer)
        'ajoute la même couleur que celle de l'utilisateur
        .Interior.ColorIndex = RUser.Interior.ColorIndex
        
        'ajoute les bordures
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
End Sub

Bon courage !
A +

[EDIT] Désolé, je n'avais pas vu que vous aviez continué pendant que je cherchais une solution. Du coup, ma solution permet d'aller chercher le Range du user qui appelle (avec un Find car je ne vois pas mieux là tout de suite). A éventuellement adapter pour coller à la solution d'Olivier
--
macsscam

 

[pat17]

Re : copier couleur de cellule

Pour odesta
Cela ne me gène pas car on ne travaille pas le WE

Pour macsscam
Merci pour ta solution, je regarde et te tiens au courant

 

[Odesta]

Re : copier couleur de cellule

Re.
Très bien cette récup de couleur macsscam, perso je me galérais en essayant de les récup au chargement de la liste de nom, par nom, mais c'était pas terrible.

Et pour les bordures, on pourrait simplifier par :

With .Borders()
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Voire par
.Borders().LineStyle = xlContinuous

 

[macsscam]

Re : copier couleur de cellule

Merci,

En effet, on peut factoriser un peu les borders.
La solution d'Olivier est très propre, à tester pour voir si elle fait bien ce que tu attends.

--
macsscam