J'aimerais donner un effet d'embossage à un groupe de cellules...

sub Embossage()
  Dim NBL As Integer, NBC As Integer, PL As Integer, PC As Integer
  Dim couleur1 As Double, couleur2 As Double, RELIEF As String
  RELIEF = UCase(Trim(InputBox("pour Relief tapez R" _
           & Chr(10) & "pour Creux Tapez C" _
           & Chr(10) & "pour effacer tapez 0" _
           & Chr(10) & "second caractère possible :" _
           & Chr(10) & "G pour Gold" _
           & Chr(10) & "1 2 3 4 ou V", _
           "Geedee Embossage", "Relief")))
  Select Case Left(RELIEF, 1)
  Case "C"
  couleur1 = RGB(64, 64, 64): couleur2 = RGB(255, 255, 255)
  Case "R"
   couleur1 = RGB(255, 255, 255): couleur2 = RGB(64, 64, 64)
  Case Else
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders.LineStyle = xlNone
    exit sub
  End Select
  If Mid(RELIEF, 2, 1) = "G" Then
    Selection.Interior.ColorIndex = 6
    Selection.Interior.PatternColorIndex = 22
    Selection.Interior.Pattern = xlGray25
  Else
  Selection.Interior.ColorIndex = 15
  End If
  Selection.Borders.LineStyle = xlNone
  '-----------------------------------
  NBL = Selection.Rows.Count
  NBC = Selection.Columns.Count
  PL = Selection.Row
  PC = Selection.Column
  Set AngleHG = Cells(PL, PC)
  Set ANGleHD = Cells(PL, PC + NBC - 1)
  Set AngleBG = Cells(PL + NBL - 1, PC)
  Set AngleBD = Cells(PL + NBL - 1, PC + NBC - 1)
 
  '----------Bordure Haut
  Range(AngleHG, ANGleHD).Select
  Selection.Borders(xlTop).Weight = xlThick
  Selection.Borders(xlTop).Color = couleur1
  '----------Bordure Gauche
  Range(AngleHG, AngleBG).Select
  Selection.Borders(xlLeft).Weight = xlThick
  Selection.Borders(xlLeft).Color = couleur1
  '----------Bordure Bas
  Range(AngleBG, AngleBD).Select
  Selection.Borders(xlBottom).Weight = xlThick
  Selection.Borders(xlBottom).Color = couleur2
  '----------Bordure Droite
  Range(ANGleHD, AngleBD).Select
  Selection.Borders(xlRight).Weight = xlThick
  Selection.Borders(xlRight).Color = couleur2
  '----------------------
  With Union(AngleHG, ANGleHD, AngleBG, AngleBD)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Name = "Wingdings"
    .Font.Size = 16
    Select Case Mid(RELIEF, 2, 1)
    Case Is = "1"
      .Value = "m"
    Case Is = "2"
      .Value = "l"
    Case Is = "3"
      .Value = Chr(123)
    Case Is = "4"
      .Value = "£"
    Case Is = "V"
      .Font.Name = "Webdings"
      .Value = "x"
      Case Is = "G"
    Case Else
      .Value = ""
    End Select
  End With
  end sub

Astuce illustrée par ce classeur
gd-annivdisciplus