Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

eutrophisation

XLDnaute Occasionnel
Bonjour
Une nouvelle fois je fais appel à vos connaissances ; il s'agit cette fois ci d'automatiser la police et la hauteur de la ligne en cliquant sur la cellule. Lorsque je saisie sur la cellule la taille de la police serait de 14 et la hauteur de la ligne serait de 24 en quittant cette cellule la taille de la police reprendra sa taille initiale qui etait de 10 et en meme temps la hauteur qui etait de 12.
Supposant que je clique sur la cellule ou deja des caracteres ont été saisis ces derniers qui etaient de 12 seront de 14 ainsi que la hauteur de la ligne qui serait de 24.
Salutations sportives
 
Re : hauteur et police

Bonjour eutrophisation,

pour une seule cellule ?

si oui :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$5" Then
Target.RowHeight = 24
Target.Font.Size = 14
Else
Range("D5").RowHeight = 12
Range("D5").Font.Size = 10
End If
End Sub

Edit : Bonjour Efgé 😉
 
Dernière édition:
Re : hauteur et police

Bonjour eutrophisation, tototiti 🙂,
Comme j'ai préparé quelque chose, je le poste...
A mettre dans le code de la feulle concernée.
Code:
[COLOR=blue]Private Sub[/COLOR] Worksheet_SelectionChange([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range)
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
UsedRange.Font.Size = 12
Rows.RowHeight = 14
Target.Font.Size = 14
Target.Rows.RowHeight = 24
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]End Sub[/COLOR]
Cordialement
 
Re : hauteur et police

Merci à vous deux je souhaiterais que cela concerne que les lignes a21:a2020 soit deux milles lignes d'une part et d'autre part j'ai d'autres codes dans ma feuille que je transmets
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column > 13 And Target.Count = 1 Then ' colonne 3 seulement
If Target.Comment Is Nothing Then Target.AddComment ' Création commentaire
Target.Comment.Text Text:=Target.Comment.Text & _
Target.Value & " Modifié par:" & Environ("UserName") & _
" Le " & Now & vbLf
Target.Comment.Shape.TextFrame.AutoSize = True
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("p21:an3020")) Is Nothing Then Exit Sub
Cancel = True
With Target.Font
Select Case .ColorIndex
Case Is = xlAutomatic
.ColorIndex = 5
Case 5
.ColorIndex = 3
Case 3
.ColorIndex = 53
Case 53
.ColorIndex = 10
Case Else
.ColorIndex = xlAutomatic
End Select
.Bold = IIf(.ColorIndex = xlAutomatic, 0, 1)
End With

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set champ = Range("p21:ej2020")
If Not Intersect(champ, Target) Is Nothing And Target.Count = 1 Then
champ.Interior.ColorIndex = xlNone
col1 = champ.Column
col2 = col1 + champ.Columns.Count - 1
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36
Dim plg
Set plg = Intersect(Rows(Target.Row), Range("m21:m2027"))
If Target.Rows.Count = 1 And Not plg Is Nothing Then [j6].Value = plg.Value
End If
End Sub

ne pensez vous pas qu'il peut avoir incompatibilité avec mes codes ce que vous m'avez proposé.
MERCI
 
Re : hauteur et police

désolé je n'arrive pas à mixer en tout cas merci

Ci joint fichier dans le cas ou vous voulez mixer votre code avec les miens vous me rendriez un grand service.
Salutations sportives
 

Pièces jointes

Dernière édition:
Re : hauteur et police

Re
As tu vraiment essayé comme te la si bien conseillé Tototiti ?
Tu ne peux pas avoir deux codes
Code:
[COLOR=#0000ff]Private Sub[/COLOR] Worksheet_SelectionChange([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range)
Ce n'est pas trés complexe...
Code:
[COLOR=blue]Private Sub[/COLOR] Worksheet_SelectionChange([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Range)
[COLOR=blue]If Not[/COLOR] Intersect(Target, Rows("21:2020")) [COLOR=blue]Is Nothing Then[/COLOR]
    Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
    UsedRange.Font.Size = 12
    UsedRange.RowHeight = 14
    Target.Font.Size = 14
    Target.Rows.RowHeight = 24
    Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=blue]Set[/COLOR] champ = Range("p21:ej2020")
[COLOR=blue]If Not[/COLOR] Intersect(champ, Target) [COLOR=blue]Is Nothing And[/COLOR] Target.Count = 1 [COLOR=blue]Then[/COLOR]
    champ.Interior.ColorIndex = xlNone
    col1 = champ.Column
    col2 = col1 + champ.Columns.Count - 1
    Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36
    [COLOR=blue]Set[/COLOR] plg = Intersect(Rows(Target.Row), Range("m21:m2027"))
    [COLOR=blue]If[/COLOR] Target.Rows.Count = 1 [COLOR=blue]And Not[/COLOR] plg [COLOR=blue]Is Nothing Then[/COLOR] [j6].Value = plg.Value
[COLOR=blue]End If[/COLOR]
[COLOR=blue]End Sub[/COLOR]
Cordialement
 
Re : hauteur et police

Re,

Allez, un indice supplémentaire

ça contient Rows("21:

tu as beau être novice, veux-tu comprendre ce qui t'est fourni ou souhaites-tu seulement une solution à ta problématique ?

Si la programmation ne t'intéresse pas, ça peut se comprendre...
 
Re : hauteur et police

Re
Tu as choisi mon code, donc on va voir ensemble:
Tu repère les lignes que je t'ai fourni au post 3 dans ma dernière proposition.
Tu remarque que ces lignes sont encadrées par une condition (If.. ...End If)
C'est cette condition qui est à modifier. Donc...
Cordialement
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
646
Retour