Sujet Précédent Sujet Suivant

EXCEL: Copier la mise en forme

zeuslp -  
Patrice33740 Messages postés 8930 Statut Membre -
Bonjour,

je souhaiterais savoir comment copier une mise en forme (remplissage de cellule) gâce à un lien en deux feuilles excel du type :

=feuille1!A1 ==> celui là ne copie que le contenu de la cellule.

Merci de votre aide.
A voir également:

2 réponses

Réponse 1 / 2
piopicolo Messages postés 1422 Statut Membre 193
 
utilisez la fonction fx CELLULE("contenu", A1) : voir aide associée.
0
piopicolo Messages postés 1422 Statut Membre 193
 
tu écris simplement : = Cellule("format", A1) et c'est fini
0
Patrice33740 Messages postés 8930 Statut Membre 1 782
 
= Cellule()
Renvoie des informations sur la mise en forme, la position ou le contenu de la cellule supérieure gauche d'une référence
= Cellule("format", A1)
Renvoie la valeur de texte correspondant au format de nombre défini pour la cellule. Les valeurs de texte des différents formats sont répertoriés dans le tableau ci-dessous. Renvoie "-" à la fin de la valeur de texte si la cellule est formatée en couleur pour les valeurs négatives. Renvoie "()" à la fin de la valeur de texte si la cellule est formatée avec des parenthèses pour les valeurs positives ou pour toutes les valeurs.

dixit Microsoft

Cela ne permet pas de copie la mise en forme !!!
0
Réponse 2 / 2
Patrice33740 Messages postés 8930 Statut Membre 1 782
 
Seule une macro permet de faire cela.
A copier dans le code de la feuille (clic droit sur l'onglet / visualiser le code) : 
Option Explicit

Private Sub Worksheet_Activate()
  Call CopierFormats
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Call CopierFormats
End Sub

Private Sub CopierFormats()
Dim wsh_act As Worksheet
Dim sel_act As Range
Dim cel_act As Range
Dim wsh_dst As Worksheet
Dim sel_dst As Range
Dim cel_dst As Range
Dim cel As Range
Dim dst As Range
Dim adr As String
Dim frm As String
Dim fx As String
Dim ptr As Integer

'mémorisation du contexte
Set wsh_act = ActiveSheet       'feuille active
'Set sel_act = Selection        'sélection (sur la feuille active)
'Set cel_act = ActiveCell       'cellule active (sur la feuille active)
Set wsh_dst = Worksheets(1)     'feuille destination
wsh_dst.Activate
Set sel_dst = Selection        'sélection (sur la feuille destination)
Set cel_dst = ActiveCell       'cellule active (sur la feuille destination)

'Arrêt : mise à jour écran, calculs, évènements
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'copie des formats
For Each cel In wsh_dst.UsedRange.Cells
  If cel.HasFormula Then
    frm = Mid(cel.Formula, 2)
    ptr = InStr(1, frm, "!")
    If ptr > 0 Then fx = Replace(Mid(frm, 1, ptr - 1), "'", "") Else fx = wsh_dst.Name
    adr = Mid(frm, ptr + 1)
    Set dst = Nothing
    On Error Resume Next
    Set dst = Worksheets(fx).Range(adr)
    On Error GoTo 0
    If Not dst Is Nothing Then
      dst.Copy
      cel.PasteSpecial (xlPasteFormats)
    End If
  End If
Next
Application.CutCopyMode = False

'restitution du contexte
sel_dst.Select
cel_dst.Activate
wsh_act.Activate

'réactiver : mise à jour écran, calculs, évènements
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub
0