[XL-2000] coller le résultat d'une MFC [Résolu]

[darkvadave]

Bonsoir,
je cherche à copier une plage de cellules contenant des MFC et à coller leur contenu sur une autre plage.
Le problème : la MFC est également collée, mais le résultat n'est pas celui escompté car j'ai des références relatives dans mes MFC (et je ne peux pas utiliser que des références absolues).
Ma question : comment coller le contenu d'une cellule avec le résultat de la MFC (mais pas la MFC) . Par exemple, une plage de cellules d'un planning où se cottoient des cellules colorée en bleu pâle (JF, week-end...) grâce à une MFC et des cellules contenant des informations (texte, couleur de fond et de polices...).
NB : le but est d'élaborer un planning annuel pour une personne (pouvant tenir sur une ou deux pages) à partir du planning d'une équipe (une colonne de 365 lignes) avec des WE parfois travaillés (donc parfois des cellules colorées pour marquer la garde) mais en conservant la couleur bleuté des WE et JF de la MFC quand ces jours ne sont pas attribués.
Merci d'avance.

[pressdell]

Bonjour dark,

Peux tu essayer ceci :

Code :

 .PasteSpecial Paste:=xlPasteValues

ÉDIT : Cela correspond au collage special d'excel, valeurs uniquement.

[ZebreLoup]

Ca c'est pour copier les valeurs, pour le format sans garder la MFC je ne vois pas de solution simple à part boucler sur toutes les cellules et copier la couleur de fond, la couleur de police...
Je vais voir si je trouve mieux

[Golonne]

Bonjour à tous,

pressdell a la bonne solution mais le bon paramètre est le suivant :

Code :

.PasteSpecial (xlPasteValuesAndNumberFormats)

Cordialement,

Guillaume

[ZebreLoup]

Tu as testé ? J'avais essayé ça sans grande conviction et ça ne marchait pas chez moi.

[Golonne]

Envoyé par ZebreLoup

Tu as testé ? J'avais essayé ça sans grande conviction et ça ne marchait pas chez moi.

Oui, j'ai testé dans un classeur en mettant en A1 "11" et une MFC (colorie le fond de cellule en vert si valeur > 10) avec le code suivant

Code :

1
2
3
4
5
6
7
8
9
Sub test()
 
ActiveSheet.Cells(1, 1).Copy
 
    ActiveSheet.Cells(2, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
 
Application.CutCopyMode = False
 
End Sub

Chez moi ça marche (XL2003)

Cordialement,

Guillaume

[ZebreLoup]

C'est bizarre, ça ne marche pas chez moi en faisant exactement la même chose. On est d'accord, tu n'as plus de MFC en A2, mais un fond vert quand même.

[Golonne]

Euh non je n'ai ni fond vert ni MFC...

[ZebreLoup]

On est d'accord ! Que David me corrige si je me trompe mais il voulait coller les valeur et le format résultat de la MFC. Le but dans ton exemple serait donc de ne plus avoir de MFC, mais un fond vert "en dur".

[Golonne]

Au temps pour moi j'avais mal lu sa demande. Je pensais qu'il ne voulait plus du MFC ni de ses effets

Ca change tout !

[ZebreLoup]

Le code suivant devrait marcher, il est censé gérer tous les cas de MFC.
Par contre, je ne copie que la couleur de la cellule et de la police, il faut compléter là où j'ai écris "Et toutes les autres propriétés".

Code :

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
Option Explicit
 
Public Sub test()
    copieSansMFC Range("A1:C3"), Range("A5")
End Sub
 
'Pour le moment, ne marche pas avec des selections multiples
Public Sub copieSansMFC(maSelection As Range, maCible As Range)
    Dim iRow, iCol, i As Integer
    Dim c1 As Range
    Dim c2 As Range
 
    For iRow = 1 To maSelection.Rows.Count
        For iCol = 1 To maSelection.Columns.Count
 
            Set c1 = maSelection.Cells(iRow, iCol)
            Set c2 = maCible.Offset(iRow - 1, iCol - 1)
 
            c2.Value = c1.Value
 
            If c1.FormatConditions.Count > 0 Then
                For i = 1 To c1.FormatConditions.Count
                    If FormatConditionActive(c1, i) Then
                        c2.Font.Color = c1.FormatConditions(1).Font.Color
                        c2.Interior.Color = c1.FormatConditions(1).Interior.Color
                        'Et toutes les autres propriétés
                    End If
                Next i
            End If
 
        Next iCol
    Next iRow
End Sub
 
'Teste si une mise en forme conditionnelle est "active" ou pas
Private Function FormatConditionActive(rg As Range, nCond As Integer) As Boolean
    Dim fc As FormatCondition
    Dim Temp As Variant
    Dim Temp2 As Variant
 
    If nCond > rg.FormatConditions.Count Then
        FormatConditionActive = False
        Exit Function
    End If
 
    FormatConditionActive = False
    Set fc = rg.FormatConditions(nCond)
 
    Select Case fc.Type
        Case xlCellValue
            Select Case fc.Operator
                Case xlBetween
                    Temp = GetStrippedValue(fc.Formula1)
                    Temp2 = GetStrippedValue(fc.Formula2)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) >= CDbl(fc.Formula1) And _
                           CDbl(rg.Value) <= CDbl(fc.Formula2) Then
                           FormatConditionActive = True
                           Exit Function
                       End If
                   Else
                      If rg.Value >= Temp And _
                         rg.Value <= Temp2 Then
                         FormatConditionActive = True
                         Exit Function
                      End If
                   End If
 
                Case xlGreater
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) > CDbl(fc.Formula1) Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    Else
                       If rg.Value > Temp Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
                Case xlEqual
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) = CDbl(fc.Formula1) Then
                           FormatConditionActive = True
                           Exit Function
                       End If
                    Else
                       If Temp = rg.Value Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
 
                Case xlGreaterEqual
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) >= CDbl(fc.Formula1) Then
                           FormatConditionActive = True
                           Exit Function
                       End If
                    Else
                       If rg.Value >= Temp Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
 
                Case xlLess
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                        If CDbl(rg.Value) < CDbl(fc.Formula1) Then
                           FormatConditionActive = True
                           Exit Function
                        End If
                    Else
                        If rg.Value < Temp Then
                           FormatConditionActive = True
                           Exit Function
                        End If
                    End If
 
                Case xlLessEqual
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) <= CDbl(fc.Formula1) Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    Else
                       If rg.Value <= Temp Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
 
                Case xlNotEqual
                    Temp = GetStrippedValue(fc.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(rg.Value) <> CDbl(fc.Formula1) Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    Else
                       If Temp <> rg.Value Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
               Case xlNotBetween
                    Temp = GetStrippedValue(fc.Formula1)
                    Temp2 = GetStrippedValue(fc.Formula2)
                    If IsNumeric(Temp) Then
                       If Not (CDbl(rg.Value) <= CDbl(fc.Formula1)) And _
                          (CDbl(rg.Value) >= CDbl(fc.Formula2)) Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    Else
                       If Not rg.Value <= Temp And _
                          rg.Value >= Temp2 Then
                          FormatConditionActive = True
                          Exit Function
                       End If
                    End If
 
           End Select
 
 
        Case xlExpression
            If Application.Evaluate(fc.Formula1) Then
               FormatConditionActive = True
               Exit Function
            End If
    End Select
 
End Function
 
Function GetStrippedValue(CF As String) As String
    Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
       Temp = Mid(CF, 3, Len(CF) - 3)
       If Left(Temp, 1) = "=" Then
           Temp = Mid(Temp, 2)
       End If
    Else
       Temp = CF
    End If
    GetStrippedValue = Temp
End Function

[darkvadave]

Bonsoir,
merci pour toutes ces réponses.
Effectivement, je cherche à conserver uniquement le résultat de la MFC (en l'occurence une couleur de cellule), dons surtout pas la MFC elle-même (puisqu'elle donnerait un résultat erroné).
La solution

Code :

.PasteSpecial (xlPasteValuesAndNumberFormats

ne fonctionne pas sous excel 2000.La solution de Zebreloup semble assez lourde : je vais m'y atteler pour voir ce que ça donne.

[darkvadave]

Bonjour,
j'ai essayé la macro : ça fonctionne mais uniquement si on cherche à copier une cellule vide.
Je m'explique :
- si je fais une mfc "valeur 0 de la cellule donne couleur rouge", alors ça fonctionne : j'obtiens une cellule colorée en rouge exactement où je le souhaite,
- si je fais "valeur 3 donne couleur rouge", alors, quand j'utilise la macro, le 3 disparait de la cellule source (qui perd alors sa couleur rouge) et je n'obtiens rien dans la cellule cible (tout se passe comme si on fesait un couperpcoller).
J'ai a peu près intégré les 2 1ères macro (test et copie sans mfc), mais je décroche sur les suivantes.
NB : dans la macro test, la première plage est celle des cellules à copier, la deuxième est uniquement la première cellule de la zone cible (sinon, on obtient autant d ecopies que de cellules dans la zone cible indiquée).
Autre question : quand on copie une cellule colorée par mfc avec cette macro, on ne peut plus effacer son contenu (comme il n'y a pas de mfc dans la cellule cible, on ne peut pas la réinitialiser) : existe-t-il une solution pour effacer son contenu autrement qu'en supprimant la cellule?

[ZebreLoup]

C'est bizarre ça marche chez moi, tu aurais un exemple de valeur et de MFC ?

Je n'ai pas bien compris ta dernière question, pour effacer seulement le contenu d'une cellule, tu as ClearContents, et pour le format, tu as ClearFormat. C'est ça que tu voulais ?

[darkvadave]

Bonjour Zèbreloup,
c'était bien le sens de ma question et ta réponse fonctionne : en fait, on ne peut pas effacer le résultat de la macro qui copie et colle le résultat d'une mfc autrement que par une macro(

Code :

ClearFormats

fonctionne bien).
Pour le reste, voici en pièce jointe le fichier qui me sert à évaluer la macro : on constate quelques anomalies en la faisant fonctionner.

[ZebreLoup]

Il n'y est pas par défaut, mais il existe un bouton "Effacer la mise en forme" que tu peux ajouter dans Excel.
Je regarde ton fichier.

En fait la macro marche très bien si tu n'ajoutes pas

Code :

1
2
 maSelection = Range("zone1")
 maCible = Range("zone2")

Je ne sais pas pourquoi tu as fait ça vu que ce sont des paramètres de la procédure.
Relis peut-être des tutos sur l'utilisation des procédures et fonctions avec paramètres.
A moins que ce soit le comportement voulu (et dans ce cas il faut s'assurer d'un passage par référence), on ne modifie pas les paramètres d'une procédure. De plus dans ce cas, Range était un object, il aurait fallu mettre un Set devant. Quand tu ne mets pas le Set, il prend le range comme un tableau de valeurs, et il lui attribut Range("zone1"), mais comme il attend une valeur, il prend seulement la valeur de la première cellule et c'est pour ça qu'il remet tout à vide. Si tu mets "toto" en A1, tu comprendras ce qui se passe.

EDIT : Non, ça ne marche pas avec "toto", mais enlève les 2 lignes en trop et ce sera bon.

[darkvadave]

Bonsoir,
j'avais fais un amalgame entre les macro test et copie sans mfc, du coup, la boulette (ceci dit, il y a pas mal de choses que je ne maitrise absolument pas en vba quand bien même je potasse régulièrement le sujet, du fait que je ne savais même pas que ça existait il y a encore quelques semaines : du coup, je n'avais pas trop saisi pourqoui on passait par une macro test pour lancer la macro copieSansMFC).
Merci encore

Le problème du copier-coller des résultats d'une mfc est résolu, mais j'ai encore une question sur ce sujet :
comment modifier la macro copieSansMFC pour qu'elle copie le résultat de la mfc quand il y en a un, mais aussi :
- la couleur de fond (la couleur de police...) quand il n'y a pas de mfc
- la couleur donnée à la cellule "par dessus" la couleur de mfc ?
J'ai essayé avec

Code :

1
2
elseif FormatConditionActive(c1,i)=false then
c2.Interior.ColorIndex = c1.Interior.ColorIndex

juste après " 'et toutes les autres propriétés ", sans succès, et je ne vois pas où il faut modifier le code.

[ZebreLoup]

Ne le mets pas dans un Else, mais plutôt juste après le

Code :

c2.Value = c1.Value

Et utilises plutôt Color que ColorIndex, au cas où la couleur choisie ne soit pas une couleur de la palette.

Comme ça tu auras par défaut la couleur de fond "normale" et la couleur "MFC" si celle-ci est vérifiée.

Je n'ai pas compris ton deuxième tiret par contre.

[darkvadave]

Merci Zebreloup,
ça fonctionne parfaitement et répond aux 2 points (j'ai gardé colorindex puisque je colorie mon planning en passant par colorindex).
Pour le 2ème tiret, j'entendais que lorsqu'on applique une mfc (par exemple couleur bleu pale si la cellule est un dimanche dans un planning) et bien on a une couleur (bleu pale en l'occurence) qu'on ne peut pas modifier avec la palette de couleur excel , mais on peut par contre appliquer par-dessus une couleur (disons bleu foncé par ex. pour marquer un jour de garde dans un planning) par l'intermédiaire d'une macro (via une barre de coloriage dans mon cas) tout en gardant la possibilité de faire réapparaître la couleur bleu pale de la mfc si je change mon planning et décide d'effacer la garde pour la déplace sur un autre dimanche (toujours via ma barre de coloriage) : j'ai donc bien une couleur de fond (celle de la mfc) par-dessus laquelle j'applique une autre couleur (ce qui masque la couleur de la mfc), et je retrouve bien la couleur initiale quand je fais disparaitre la couleur "décorative", comme si j'avais peins par-dessus (sans perdre l'info initiale).