Liste déroulante Fermé

Question

Bonjour a tous, bonjour forum,

Configuration: Windows10 /Excel VBA 2007/ Internet Explorer 11.0

J'ai une liste déroulante situé sur la Feuil1 en colonne (H).
Dans la Feuil2 colonne (A) début de ma liste déroulante (10 Mots pour l'instant) en (A3) car (A1:A2)=entète

Je souhaiterai svp en VBA avoir si possible la première lettre de chaque mot en majuscule "Rouge" et la suite du mot en "Noir" minuscule.

Et encore si possible avec "bordure" haut et bas de chaque cellule pour une meilleure visibilité.

En Feuil1 du code plus un module1 (macros) feuil2 aucun code juste la liste des 10 noms.

Je vous remercie pour votre aide, je vous souhaite un très bon dimanche.

Cdlt Ray

cs_Le Pivert · Answer

Bonjour,

Comme ceci à adapter:

Option Explicit
Private Sub CommandButton1_Click()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
    Set FL1 = Worksheets("Feuil1") 'adapter la feuille
    NoCol = 1 'lecture de la colonne A adapter la colonne
    For NoLig = 1 To Range("A" & Rows.Count).End(xlUp).Row 'démarre à la 1ère ligne à adapter
         FL1.Cells(NoLig, NoCol).Select
       miseenpage
    Next
    Set FL1 = Nothing
End Sub
 Sub miseenpage()
  ActiveCell.Value = UCase(Left(ActiveCell.Value, 1)) & LCase(Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)) '1ère lettre en majuscule
  ActiveCell.Characters(Start:=1, Length:=1).Font.Color = RGB(255, 0, 0) '1ère lettre en rouge
  ActiveCell.Borders.Color = RGB(0, 0, 0) 'bordure noire
  ActiveCell.Borders.Weight = 3 'épaisseur bordure
End Sub

vieuxray · Answer

Salut cs_Le Pivert,

Merci pour ta réponse.

je n'ai pas besoin de 'commandbutton'

Comment svp adapter ton code si possible dans le code ci dessous sachant que juste les noms de la liste déroulante sont dans la Feuil2.

Merci pour ton aide une bonne soirée a toi.

Cdlt Ray



Private Sub Worksheet_SelectionChange(ByVal Target As Range)End sub

vieuxray · Answer

Re 
meric pour le new code LOL

Bizarre avec ce nouveau code rien ne se passe sur la feuil2 ma liste déroule n'ai pas modifier
pas de majuscule ni couleur ni bordures
bonne soirée

Ray

vieuxray · Answer

Bonjour cs_Le Pivert

Merci pour tes conseils, j'ai essayer d'adapter ton code au mien mais je n'y parvient pas.

Pour la liste qui se trouve dans la Feuil2, je laisse comme c'était. Donc il ni a plus de code mais juste et simplement ma liste déroulante.

Sur la Feuil1 quand la liste déroulante s'ouvre en colonne (H) je souhaiterai svp avoir les noms avec une majuscule rouge la suite du mot en noir minuscule plus gras, bordure haut et bas de la cellule.

J'ai un peu merdouiller a propos de mes explications, je pense que c'est plus clair cette fois. désolé LOL

Merci et bonne semaine a toi.

Cdlt Ray


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim R As Range                                                                             'Plage contenant les éléments de la liste de choix
  KeyShift = False                                                                           'Ràz mémoire touche Shift appuyée
  Me.cbxChoix.Visible = False                                                         'Masquer la liste de choix mobile
If ChangedD > 0 Then                                                                    'Si la colonne D vient d'être modifiée
    MemNavDH = ChangedD: ChangedD = 0                                  'Mémoriser le passage de D à H et Ràz mémoire ligne colonne D
    Me.Cells(MemNavDH, "H").Activate                                            'Passer en colonne H, en déclenchant un nouveau Worksheet_SelectionChange.
Exit Sub                                                                                           'Terminer
End If
'
'If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then                     'adapter la colonne
'   On Error Resume Next
'         ActiveCell.Value = UCase(Left(ActiveCell.Value, 1)) & LCase(Right(ActiveCell.Value, Len(ActiveCell.Value) - 1))                       '1ère lettre en majuscule
'
'         ActiveCell.Characters(1, 1).Font.ColorIndex = 3 '1ère lettre en rouge
'         ActiveCell.Borders.ColorIndex = 0 'bordure noire
'         ActiveCell.Borders.Weight = 3 'épaisseur bordure
'End If

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  
  If Not Intersect(Target, Columns("H")) Is Nothing Then                'Pour une sélection en colonne H,
    If Not (Target.Count > 1 Or Target.Row < 3) Then                     'Avec une seule cellule sélectionnée après la ligne 2
      If Not (Target.Offset(0, -5).Formula = "") Then                          'Et un montant en colonne C :
      Set R = [Liste_Règlement]                                                         'Définir la plage contenant les éléments de la liste de choix
      Me.cbxChoix.List = R.Value                                                       'Définir les éléments de la liste de choix

'DIMENSION BOITE LISTE DÉROULANTE
      
      Me.cbxChoix.Height = Target.Height + 5                                    'Hauteur de la liste de choix = hauteur cellule + 3
      Me.cbxChoix.Width = Target.Width + 3                                       'Largeur de la liste de choix = largeur cellule + 21 (bouton en plus)
      Me.cbxChoix.Top = Target.Top                                                   'Position verticale liste de choix = position verticale cellule
      Me.cbxChoix.Left = Target.Left - 0                                               'Position horizontale liste de choix = position horizontale cellule (aligner les textes)
'
      Me.cbxChoix = UCase(Left(Me.cbxChoix.Value, 1)) & LCase(Right(Me.cbxChoix.Value, Len(Me.cbxChoix.Value) - 1))                                  '1ère lettre en majuscule
      Me.cbxChoix.Characters(1, 1).Font.ColorIndex = 3                                                                                                                                            '1ère lettre en rouge
      Me.cbxChoix.Borders.ColorIndex = 0
      Me.cbxChoix.Bold = True
'
      If Target.HorizontalAlignment = xlCenter Then                           'Si l'alignement H de la cellule est centré
         Me.cbxChoix.TextAlign = fmTextAlignCenter                           'Center le texte de la liste de choix
      Else                                                                                             'Sinon
         Me.cbxChoix.TextAlign = fmTextAlignLeft                                'Aligner le texte de la liste de choix à gauche
      End If
      
      Me.cbxChoix.Text = Target.Value                        'Valeur de la liste de choix = valeur de la cellule, provoque cbxChoix_Change
      Me.cbxChoix.DropDown                                       'Ouvrir la liste déroulante
      Me.cbxChoix.Visible = True                                  'Rendre visible la liste de choix
      Me.cbxChoix.Activate                                           'Placer le curseur dans la liste de choix
    End If
    End If
  End If

'BARRE DE REPÈRE MULTICOLORE

Dim arrColors As Variant, lastRow As Long, rng As Range, lCol As Byte
   If Target.Row < 3 Or Target.CountLarge > 1 Then Exit Sub
       arrColors = Array(40, 40, 44, 40, 40, 44, 6, 40, 1, 1)                        'Couleurs de la barre multicolore plus deux pour résultat test formule colonne (I et J)
    
    With Feuil1
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Cells(3, 1).Resize(lastRow - 2, 10)
        rng.Interior.ColorIndex = xlColorIndexNone
        If Not Intersect(Target, rng) Is Nothing Then
            
            For lCol = 0 To 9
                  .Cells(Target.Row, lCol + 1).Interior.ColorIndex = arrColors(lCol)
            Next lCol
        Else
            Exit Sub
        End If
    End With
End Sub

vieuxray · Answer

Salut cs_Le Pivert,

Merci pour ta réponse et pour les conseils.

ça fonctionne presque pour l'instant,  j'ai bien les borders et la majuscule en rouge.

Je souhaiterai svp avoir si possible la première lettre de chaque mot en majuscule "Rouge" plus en "Gras" 
et la suite du mot en "Noir minuscule". 

merci a toi, je te souhaite la bonne soirée.

Cdlt Ray

Sub miseenpage()  ActiveCell.Value = UCase(Left(ActiveCell.Value, 1)) & LCase(Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)) '1ère lettre en majuscule  ActiveCell.Characters(Start:=1, Length:=1).Font.Color = RGB(255, 0, 0) '1ère lettre en rouge'Rem mise en gras majuscule'Rem mise en noir et minuscule a la suite de la majuscule   ActiveCell.Borders.Color = RGB(0, 0, 0) 'bordure noire  ActiveCell.Borders.Weight = 3 'épaisseur bordureEnd Sub

cs_Le Pivert · Answer

Voici un exemple, cela sera plus simple:

 https://www.cjoint.com/c/HIrrpKu5UkQ

vieuxray · Answer

Re salut

Merci pour le fichier que j'ai bien regarder mais je n'arrive pas a voir comment faire pour mettre en code ce que je voudrais. 

'Rem mise en gras majuscule'Rem mise en noir et minuscule a la suite de la majuscule 

J'ai fait pas d'essai mais ca ne marche pas , tant pis je encore chercher demain

bonne soirée et merci pour ton aide et le fichier.

Cdlt Ray

vieuxray · Answer

Salut cs_Le Pivert,

Malgré le fichier, que j'ai bien regarder, et tous les essais que j'ai pu faire, je n'ai pas réussi a faire ce que je voulais.

Que se soit par fichier ou par sub macro.

Alors tant pis je vais me contenter de ce que j'ai.

Merci pour le fichier, bonne soirée a toi.

Cdlt Ray

Liste déroulante

8 réponses

Discussions similaires

Newsletters