Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Copier ou reproduire que les mises en formes conditionnelles

11 réponses
Avatar
rmill...
Bonjour,

Je dois réussir Í  soit copier ou Í  reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents.

Mais ... sans ... les formats des cellules.

J'ai passé des heures Í  chercher mais il semble y avoir une brèche Í  ce niveau.

Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í  la même adresse?

Auriez-vous une suggestion?

Merci Í  l'avance.

10 réponses

1 2
Avatar
MichD
Le 13/09/21 Í  13:11, a écrit :
Bonjour,
Je dois réussir Í  soit copier ou Í  reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents.
Mais ... sans ... les formats des cellules.
J'ai passé des heures Í  chercher mais il semble y avoir une brèche Í  ce niveau.
Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í  la même adresse?
Auriez-vous une suggestion?
Merci Í  l'avance.

Bonjour,
Comme ceci :
A )copier "TOUT" le contenu de la feuille dont on veut transférer les
mises en forme conditionnelles vers une autre feuille vierge
B ) Copier seulement les données de la feuille qui devait recevoir les
mises en forme conditionnelles vers la nouvelle feuille.
C ) Supprimer l'ancienne feuille
D ) Renommer la nouvelle feuille avec le nom d'onglet de l'ancienne feuille.
'----------------------------------------------
Sub test()
Dim X As String
'Feuil1 est la feuille dont tu veux copier les mises
'en forme conditionnelles
'Débute par copier tout le contenu du la feuil1 vers
'une nouvelle feuille que l'on vient d'ajouter
Worksheets("Feuil1").Copy before:=Sheets(Sheets.Count)
'Dans cette nouvelle feuille, on va copier seulement les
'données que contient la feuille4
ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula
'Supprime la feuill4 en prenant soin de conserver son nom d'onglet
With Worksheets("Feuil4")
X = .Name
Application.DisplayAlerts = False
.Delete
End With
ActiveSheet.Name = X
End Sub
'----------------------------------------------
MichD
Avatar
rmill...
Merci.
Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels).
À moins que j'ai mal compris?
Avatar
MichD
Le 13/09/21 Í  16:43, a écrit :
Merci.
Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels).
À moins que j'ai mal compris?

Et ceci :
a) Tous les "NOMS" créés au niveau d'une feuille de calcul sont
automatiquement recréés dans la nouvelle feuille lors de la copie.
B) J'ai ajouté un peu de code prenant note des différents noms faisant
partie de la "Feuil1" et la "Feuil4" que je place dans une variable
tableau (array) et je les refais Í  la fin.
C ) Tu as 2 feuilles dans la procédure.
Feuil1 : o͹ sont les mises ͠ copier dans la feuil4
Feuil4 : Nom de l'onglet o͹ seront les mises en forme conditionnelles de
la feuil1. À toi de rebaptiser les feuilles de la procédure pour les
noms des onglets des feuilles de ton environnement.
Comme je n'ai pas vu le classeur, il se peut qu'il y ait des choses dont
je n'ai pas envisagé la présence dans cette procédure. Tu devras l'ajouter!
Il y a peut-être d'autres manières de procéder, mais je termine ce que
j'ai commencé.
Important : Teste ce qui suit avec une copie du fichier original.
Dim T(), A As Long 'Variables déclarées en haut du module
'----------------------------------------
Sub test()
Dim X As String, F As String
'Feuil1 est la feuille dont tu veux copier les mises
'en forme conditionnelles
'Débute par copier tout le contenu du la feuil1 vers
'une nouvelle feuille que l'on vient d'ajouter
With Worksheets("Feuil1")
F = .Name
.Copy before:=Sheets(Sheets.Count)
End With
'Dans cette nouvelle feuille, on va copier seulement les
'données que contient la feuille4
ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula
'Supprime la feuill4 en prenant soin de conserver son nom d'onglet
With Worksheets("Feuil4")
X = .Name
A = 0
LesNoms .Name
LesNoms F
Application.DisplayAlerts = False
.Delete
End With
ActiveSheet.Name = X
Ajout_Name T
End Sub
'----------------------------------------
Sub LesNoms(F As String)
Dim N As Name, Elt As Variant
For Each N In ThisWorkbook.Names
If InStr(1, N.Name, "!", vbTextCompare) = 0 Then
If InStr(1, N.RefersTo, F, vbTextCompare) > 0 Then
A = A + 1
ReDim Preserve T(1 To A)
T(A) = N.Name & " " & N.RefersTo
ElseIf InStr(1, N.RefersTo, "!", vbTextCompare) = 0 Then
A = A + 1
ReDim Preserve T(1 To A)
T(A) = N.Name & " " & N.RefersTo
End If
End If
Next
End Sub
'----------------------------------------
Sub Ajout_Name(T())
Dim Elt As Variant, B As String
For Each Elt In T
With ThisWorkbook.Names
B = Split(Elt, " ")(0)
.Item(B).Delete
.Add B, RefersTo:=Split(Elt, " ")(1)
End With
Next
End Sub
'----------------------------------------
MichD
Avatar
rmill...
Merci encore. Je vais essayer et vous revenir,
Mais il y a 2 questions que je me pose. L'autre feuille est dans un autre classeur. Donc je crois que cela va créer des liaisons.
Et aussi ... OK pour le nom de la feuille ... mais ... j'ai une foule de lignes de codes qui fait référence Í  la feuil12. Peut-on aussi renommer le sheetCodeName?
Avatar
rmill...
Salut Í  nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code.
- Les feuilles en question sont dans 2 classeurs distincts.
- Les 2 feuilles sont nommées NOTES et sont Feuil12.
- Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri.
- Et dans l'autre classeur ... pour la feuille la police est en Times New Roman.
Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Avatar
MichD
Le 13/09/21 Í  22:48, a écrit :
Salut Í  nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code.
- Les feuilles en question sont dans 2 classeurs distincts.
- Les 2 feuilles sont nommées NOTES et sont Feuil12.
- Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri.
- Et dans l'autre classeur ... pour la feuille la police est en Times New Roman.
Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,

Il y a plus simple, comme ceci :
"xlCellTypeAllFormatConditions" copie tout le format de la cellule et
des mises en forme conditionnelles.
Avant d'effectuer la copie, tu mets chaque élément du format que tu veux
retrouver dans une variable, et tu la récupères après la copie.
tu peux faire la même chose pour les bordures... pour être plus précis.
'----------------------------------------------
Sub Test()
Dim C As Range, Adr As String
Dim S As String, P As String
Application.ScreenUpdating = False
With Worksheets("Feuil1")
.Activate
For Each C In
ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Cells
Adr = C.Address
C.Copy
With Worksheets("Feuil3").Range(Adr)
S = .Font.Size
P = .Font.Name
End With
C.Copy
With Worksheets("Feuil3")
With .Range(Adr)
.PasteSpecial xlPasteAllMergingConditionalFormats
.Font.Size = S
.Font.Name = P
'Í  toi de définir les caractéristiques de la bordure
.BorderAround LineStyle:=xlContinuous,
Weight:=xlMedium, ColorIndex:=xlAutomatic
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'----------------------------------------------
MichD
Avatar
rmill...
Super. Un grand merci.
Je travaille sur ceci et je vous reviens.
Avatar
MichD
Le 14/09/21 Í  07:30, a écrit :
Super. Un grand merci.
Je travaille sur ceci et je vous reviens.

Seulement 2 variables Í  définir :
'------------------------------------------
Sub Test()
Dim C As Range, Adr As String
Dim S As String, P As String
Dim G As Boolean, iT As Boolean
Dim St As Double, W As Double, Col As Long
Dim FeuilleSource As String, J As Long
Dim H As Long, M As Long, V As Variant
Dim FeuilleDest As String
'************Variables Í  définir******************
FeuilleSource = "Feuil1" 'Nom onglet feuille o͹ sont les mises
'en forme conditionnelles Í  copier
FeuilleDest = "Feuil3" 'Nom onglet o͹ seront copiées les
'mises en forme conditionnelles
'*****************************************************
Application.ScreenUpdating = False
With Worksheets(FeuilleSource)
For Each C In
.UsedRange.SpecialCells(xlCellTypeAllFormatConditions).Cells
Adr = C.Address
Application.CutCopyMode = False
With Worksheets(FeuilleDest).Range(Adr)
V = .Formula
S = .Font.Size
P = .Font.Name
G = .Font.Bold
J = .Font.Color
H = .Interior.Color
iT = .Font.Italic
With .Borders(xlEdgeLeft)
St = .LineStyle
Col = .ColorIndex
W = .Weight
End With
End With
C.Copy
With Worksheets(FeuilleDest)
With .Range(Adr)
.PasteSpecial xlPasteAllMergingConditionalFormats
.Formula = V
.Font.Size = S
.Font.Name = P
.Font.Bold = G
.Font.Italic = iT
.Font.Color = J
.Interior.Color = H
For M = 7 To 10
With .Borders(M)
.LineStyle = St
If .LineStyle = -4142 Then
.LineStyle = St
.ColorIndex = Col
.Weight = W
End If
End With
Next
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'------------------------------------------
MichD
Avatar
rmill...
Bonjour Í  nouveau,
J'éprouve un peu de difficulté mais j'avance.
Sauriez-vous me préciser la différence entre .PasteSpecial xlPasteFormats et .PasteSpecial xlPasteAllMergingConditionalFormats
Car j'ai cherché sans succès. Y a t'il une différences?
Avatar
rmill...
Bonjour,
J'ai adapté votre code suggéré Í  ma situation et cela fonctionne. Je vous remercie grandement.
Car cela me semblait pas possible Í  un certain moment. J'ai vraiment cherché longtemps.
J'ai vu que plusieurs au fil des ans ont aussi eu de la difficulté avec ceci.
Encore merci.
1 2