Liste déroulante
Bonjour a tous, bonjour forum,
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
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
8 réponses
-
ContributeurBonjour,
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
-
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-
Contributeur
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
se déclenche à la sélection de la cellule:
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) 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(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 If End Sub
ATTENTION
avec cette méthode à la 2 ème sélection de cellule la police est rouge!
@+
-
-
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-
ContributeurIl faut que le code soit dans le module de la Feuille 2 et que la liste soit dans la colonne A. Ensuite la macro ne se déclenche qu'à la sélection dans chaque cellule.
Voir ceci:
https://silkyroad.developpez.com/VBA/EvenementsFeuille/#LII-I
@+
-
-
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-
ContributeurCela ne sert à rien de mettre la totalité du code. Cette ligne me suffit avec son commentaire
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then 'adapter la colonne
Si j'ai mis des commentaires c'est pour qu'on les lise!
Donc adapter la colonne. Ensuite je le répète: il faut sélectionner chaque cellule pour que le changement s'opère!
Mais je ne vois pas trop l’intérêt de mettre ceci dans l'evenement Worksheet_SelectionChange. Quand les cellules sont formatées, il n'est pas nécessaire de recommencer à chaque nouvelle sélection.
je verrais plutôt cela: mettre ce code dans un module. Mettre le curseur sur action et appuyer sur la touche F5.
Option Explicit Private Sub action() Dim FL1 As Worksheet, NoCol As Integer Dim NoLig As Long Set FL1 = Worksheets("Feuil1") 'adapter la feuille NoCol = 6 'lecture de la colonne H adapter la colonne For NoLig = 1 To Range("H" & 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
Mais je me pose la question. Est-ce-que tu ne voudrais pas que les items de ta Combobox soient comme tes cellules.
Parceque là tu fais fausse route!
@+ Le Pivert
-
-
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 bordure
End Sub -
ContributeurVoici un exemple, cela sera plus simple:
https://www.cjoint.com/c/HIrrpKu5UkQ
-
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 -
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
