Noms en minuscule

Le 04/04/2020 à 09:01

Bonjour le forum

Mettre AAA BBB CCC etc.. en minuscule dans macro au double click

Merci à vous

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Indice As Integer, NbColonne As Integer
Dim Tb, TbCoul, X, TbFont, Label As String
Dim Ligne As Integer
Select Case UCase(sh.Name)
    Case "AAA", "BBB", "CCC", "DDD", "EEE"
      NbColonne = 2
  End Select

 Ligne = Range("A" & Rows.Count).End(xlUp).Row
  If (Target.Row = Ligne And Range("A" & Ligne) <> "") Or (Target.Row = Ligne + 1 And Range("A" & Ligne + 1) = "") Then
    If Target.Column = NbColonne + 1 And Target.Row >= 3 Then       ' And Range("A" & Target.Row) <> "" Then
      Application.EnableEvents = False
      TbFont = Array(5, 1)
      TbCoul = Array(35, 40)
      Tb = Array("", "Oui")
      Cancel = True

      X = UCase(Trim(Target))
      If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
        Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
        Label = Tb(Indice)
        With Target
          .Value = Label
          .Interior.ColorIndex = TbCoul(Indice)
          .Font.ColorIndex = TbFont(Indice)
        End With
        With ActiveCell.Offset(0, -NbColonne).Resize(1, NbColonne)
          If Label = "Oui" Then
            .Font.Strikethrough = True
            Target.Offset(, 1).Value = Date
            Target.Offset(, -2) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
            Target.Offset(, -1).Value = sh.Name

          Else
            .Font.Strikethrough = False
            Target.Offset(, 1).ClearContents
            Target.Offset(, -2).ClearContents
            Target.Offset(, -1).ClearContents
          End If
        End With
      End If

      Application.EnableEvents = True
    End If
  End If
Range("A1").Select
End Sub

Le 04/04/2020 à 09:46