Mise en forme
Catégorie : Cel / Col / Lig
Publié par veriland le 09-Aug-2013 22:30
Cel / Col / Lig - Mise en forme

"Je souhaiterais "encadrer" ma cellule active en rouge et si possible grossir la police pendant que je saisis. Dès que je passe à une autre cellule la cellule précédente redevient normale."

Voici une macro événementielle à placer dans "ThisWorkbook".

module

 

Seule la feuille "Saisie" est concernée
Les cellules sont bordées en bleu, ce qui, avec la sélection, donne une couleur rouge !

planning

'************************************
'partie à coller dans ThisWorkbook
'************************************

Option Explicit
'Ti 07-07-04 

Private Type TBord
  LineStyle As Integer
  Color As Long
  Weight As Integer
End Type

Dim Size, Bords(1 To 6) As TBord

Dim LastCel As Range

Private Sub Reinit()
Dim B%
  With LastCel
    For B = 1 To .Borders.Count
      .Borders(B).Color = Bords(B).Color
      .Borders(B).Weight = Bords(B).Weight
      .Borders(B).LineStyle = Bords(B).LineStyle
    Next B
    .Font.Size = Size
  End With
End Sub

Private Sub Init()
Dim B%
  With LastCel
    For B = 1 To .Borders.Count
      Bords(B).Color = .Borders(B).Color
      Bords(B).LineStyle = .Borders(B).LineStyle
      Bords(B).Weight = .Borders(B).Weight
    Next B
    Size = .Font.Size
    .Font.Size = Size + 4
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlThick
    .Borders.Color = vbCyan
  End With
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  'pour redonner à la cellule sélectionnée sa mise en forme originale
  If Not LastCel Is Nothing Then Reinit
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  'ne concerne que la feuille nommée "saisie"
  If Sh.Name <> "Saisie" Or Target.Count > 1 Then Exit Sub
  Application.ScreenUpdating = False
  If Not LastCel Is Nothing Then Reinit
  Set LastCel = Target
  Init
  Application.ScreenUpdating = True
End Sub