mise en forme

[JJ1]

Bonjour
Savez-vous s'il est possible de "cercler" un nombre (par ex) dans une cellule Excel? par ex 6 et le 6 est entouré dans la cellule (il existe bien : souligné)
merci
Bon samedi

[jeanpierre]

Bonjour JJ1, re à tous,

Sous Excel, ce n'est pas prévu, mais tu peux utiliser l'enregistreur de macro qui va te donner ceci, ou quelque chose d'approchant :

Sub tontruc()
ActiveSheet.Shapes.AddShape(msoShapeOval, 236.25, 42#, 67.5, 27.75).Select
End sub

Ensuite, reste à programmer pour que la chose se mette en place... s'il y a des conditions, sinon à chaque valeur, tu lances ta macro, en passant par la cellule active....

L'enregistreur, en tous cas.... bonne école....

Bon WE.

Jean-Pierre

Edit : Sous 2007, je ne sais pas si c'est prévu.....

[fred65200]

Bonsoir jeanpierre, JJ1

Malheureusement l'enregistreur de macro sur 2007, n'enregistre rien pour l'insertion de forme.

une autre méthode consiste à remplacer les 6 par des ⑥.

Sub SixEnRouge()

'Attention : les valeurs de cellules avec ⑥ ne seront plus considérées comme numériques.

Dim i As Integer
Dim C As Range
Dim TP As Byte
For Each C In Selection ' à adapter
  'remplace les 6 par le caractère unicode 6 cerclé  ⑥
  C = Replace(C, 6, ChrW(&H2465))  'ChrW(9317) = ChrW(&H2465), le &H indique une valeur héxadécimale
  TP = C.Font.Size + 1 'agrandissement de la police pour les ⑥
  For i = 1 To Len(C)
    'on mets les ⑥ en gras rouge et on augmente la taille de police d'un point
    If Mid(C, i, 1) = ChrW(9317) Then
      C.Characters(Start:=i, Length:=1).Font.Bold = True
      C.Characters(Start:=i, Length:=1).Font.ColorIndex = 3
      C.Characters(Start:=i, Length:=1).Font.Size = TP
    End If
  Next i
Next C

End Sub

cordialement

[Spitnolan08]

Bonsoir JJ1, jeanpierre, Fred65200,

JJ1 ne parle pas de macro dans son post... Ou alors vous avez des infos que je n'ai pas

Donc premièrement sans macro :
Insertion/Caractères spéciaux/Symboles
Police = Wingdings1 ou Wingdings2
Puis parcourir les caractères proposés : tu as toute la panoplie

Deuxièmement toujours sans macro :
Taper un 6 dans une cellule
Puis insérer une forme à l'aide de forme automatiques/Formes de base et choisir le rond puis le placer au dessus du 6 et le dimensionner.
Clic droit sur la forme puis onglet couleurs et traits : mettre la transparence à 100%
C'est la seule solution des trois proposées qui te permet d'utiliser le 6 en valeur numérique.

Troisièmement par macro, un peu plus court et basique que Fred65200. (Nota : seule la police Wingdings2 convient)

Sub Sixercle()
'Inscrit un 6 cerclé en rouge dans la cellule active
    ActiveCell.FormulaR1C1 = "o"
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Wingdings 2"
        .FontStyle = "Normal"
        .Size = 12
        .ColorIndex = 3
    End With
End Sub

Cordialement

[jeanpierre]

Re, Bonsoir Fred, bonsoir Spit,

Certes, il ne parle pas de macro, mais sans, cela reste un peu beaucoup de manip...,
Non ?

Vrai qu'il reste la ou les police(s) Wingdings1 ou Wingdings2... Ben je n'y avais pas pensé....

Pour vous souhaiter bonne nuit.

Jean-Pierre

[Spitnolan08]

Re,

Pour faire plaisir à jeanpierre, une 4ème (cinquième en comptant celle de Fred) proposition par macro. Elle place un 6 cerclé au centre de la cellule active et peut être facilement adapté à d'autres cas de figure.

Sub Sicercle()
 Dim Tsh As String, Rsh As String
Dim Tf, Lf, Wf, Hf, Ti, Li, Rh, Rw As Double
Dim Cel As Range

Set Cel = ActiveCell
Wi = 11.25  '***Convient à une police 8
Hi = 11.25

 '***Détermine les caractéristiques de la cellule de réception de l'image
Tf = Cel.Top
Lf = Cel.Left
Wf = Cel.Width
Hf = Cel.Height

Ti = Lf + Wf / 2 - Hi / 2
Li = Tf + Hf / 2 - Wi / 2

'***Insère une zone de texte avec un 6
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Ti, Li, Wi, Hi).Select
    With Selection
        .Characters.Text = "6"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
Tsh = Selection.Name
    With Selection.Characters(Start:=1, Length:=1).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 8
    End With
    With Selection.ShapeRange
        .Fill.ForeColor.SchemeColor = 65
        .Fill.Transparency = 1#
        .Line.Transparency = 1#
        .Line.Visible = msoFalse
    End With
    
 '***Insère un rond
ActiveSheet.Shapes.AddShape(msoShapeOval, Ti, Li, Wi, Hi).Select
Rsh = Selection.Name
    With Selection.ShapeRange
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .Line.ForeColor.SchemeColor = 10
        .Line.BackColor.RGB = RGB(255, 255, 255) '***ligne en rouge
    End With
    
 '***Aligne les deux formes (Normalement superfétatoire)
ActiveSheet.Shapes.Range(Array(Tsh, Rsh)).Select
Selection.ShapeRange.Align msoAlignMiddles, False
Selection.ShapeRange.Align msoAlignCenters, False
End Sub

[Spitnolan08]

Re,

J'ai essayé de supprimer la selection des 2 formes automatiques mais n'y suis pas arrivé pour la 1ère... Par contre j'ai supprimé la dernière partie du code précédent qui n'avait plus lieu d'être.

Sub Sicercle()
 Dim Tsh As String, Rsh As String
Dim Tf, Lf, Wf, Hf, Ti, Li, Rh, Rw As Double
Dim Cel As Range

Set Cel = ActiveCell
Wi = 11.25  '***Convient à une police 8
Hi = 11.25

'***Détermine les caractéristiques de la cellule de réception de l'image
Tf = Cel.Top
Lf = Cel.Left
Wf = Cel.Width
Hf = Cel.Height

Ti = Lf + Wf / 2 - Hi / 2
Li = Tf + Hf / 2 - Wi / 2

'***Insère une zone de texte avec un 6
Tsh = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Ti, Li, Wi, Hi).Name
    ActiveSheet.Shapes(Tsh).Select
    With Selection
        .Characters.Text = "6"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Characters(Start:=1, Length:=1).Font
            .Name = "Arial"
            .FontStyle = "Normal"
            .Size = 8
        End With
        With .ShapeRange
            .Fill.ForeColor.SchemeColor = 65
            .Fill.Transparency = 1#
            .Line.Transparency = 1#
            .Line.Visible = msoFalse
        End With
    End With
    
 '***Insère un rond
Rsh = ActiveSheet.Shapes.AddShape(msoShapeOval, Ti, Li, Wi, Hi).Name
    With ActiveSheet.Shapes(Rsh)
        .Fill.Transparency = 1#
        .Line.Visible = msoTrue
        .Line.ForeColor.SchemeColor = 10
        .Line.BackColor.RGB = RGB(255, 255, 255) '***ligne en rouge
    End With
    
End Sub

Bonne nuit.

[fred65200]

bonsoir à tous
une autre proposition d'après une macro que j'ai écrite sur un autre forum il y a quelque temps.

Place un dans le coin supérieur gauche des cellule contenant un 6

Option Explicit
' Chemin du SixRouge à adapter
Private Const GifImage As String = "C:\Users\Fred\Desktop\6.gif"
Sub SixRouge()
Dim i As Integer
Dim C As Range
Dim monTab As Variant
Dim Sh As Shape

monTab = Array()

' suppression des shapes de la feuille, à adapter si tu as déjà des shapes hormis les SixRouges
For Each Sh In ActiveSheet.Shapes
Sh.Delete
Next

For Each C In Selection ' à adapter
  'recherche des cellules contenant un 6
  If InStr(1, C, 6) > 0 Then
    'insertion des adresses dans un tableau
    ReDim Preserve monTab(UBound(monTab) + 1)
    monTab(UBound(monTab)) = C.Address
  End If
Next C
' insertion des SixRouges
For i = 0 To UBound(monTab)
  InsererSixRouge monTab(i)
Next
End Sub
' procédure pour insérer les SixRouges dans le coin supérieur gauche des cellules.
Sub InsererSixRouge(Adresse As Variant)
Dim SixRouge As Object
Set SixRouge = ActiveSheet.Pictures.Insert(GifImage)
Dim T As Long
Dim L As Long
T = Range(Adresse).Top
L = Range(Adresse).Left
SixRouge.Top = T
SixRouge.Left = L
Set SixRouge = Nothing
End Sub

tu trouveras un six cerclé de rouge en suivant le lien

cordialement

[JJ1]

Bonjour à tous et surtout merci, c'est très interressant.
Je ne sais pas quelle solution adopter:
La mise en forme est prévu dans le cadre d'une condition SI:
j'ai une ligne de 10 cellules par ex:
En A20:
=SI(toto>titi;A1;"")
Si condition VRAI alors la valeur de A1 apparaîtra en A20 cerclée.
Le top serait de pouvoir cercler, en fonction des conditions sur 3 lignes différentes, avec 3 couleurs!
merci encore et bonne journée

[Spitnolan08]

Bonjour le fil,

Le top serait de pouvoir cercler, en fonction des conditions sur 3 lignes différentes, avec 3 couleurs!

Par macro, ma dernière proposition convient parfaitement à ce cas de figure à condition que tu n'aies pas besoin d'utiliser le résultat.

Mais au delà de l'aspect fun de trouver une solution à ta question, pourquoi n'utilises tu pas les MFC qui sont idéalement prévues pour ce que tu veux faire Seule différence : tu n'auras pas un cercle de couleur mais un fond ou une police de couleurs différentes en fonction du résultat de ton test.

Cordialement

[JJ1]

Re,
oui je vais faire une MFC pour les numéros, c'est dommage car je voulais écrire les numéros sortis au Loto avec une mise en forme plus aboutie en agrandissant chaque cellule (ex joint boules de couleur) ça aurait fait plus pro!!!
merci à tous et bon dimanche

[fred65200]

re:

For Each C In Selection ' à adapter
  'recherche des cellules contenant un 6
  If InStr(1, C, 6) > 0 Then
    'insertion des adresses dans un tableau
    ReDim Preserve monTab(UBound(monTab) + 1)
    monTab(UBound(monTab)) = C.Address
  End If
Next C

tu n'as qu'à modifier les conditions

  If InStr(1, C, 6) > 0 And TOTO > TITI Then

Je trouve que ta demande évolue, on passe de six encerclés à l'insertion d'image.
Si tu avais été plus précis au départ, cela aurait été plus simple pour tous.
cordialement

[Spitnolan08]

Re,

Je trouve que ta demande évolue, on passe de six encerclés à l'insertion d'image.

Je suis entièrement d'accord avec Fred. Personnellement je ne sais plus ce que tu recherches... ni comment tu souhaites l'obtenir...

D'une question "simple" on se retrouve avec une problématique complexe à géométrie variable

Tu as visiblement un fichier qui définit un contexte et une idée (apparemment évolutive) du résultat à obtenir : alors joint les à ta question !
En indiquant l'état de départ et l'état final avec les explications nécessaires à la bonne compréhension du problème.

Cordialement

[JJ1]

Re,
non ma demande n'évolue pas, simplement je vous expliquais le pourquoi de mon sujet.(vous en êtes les premiers demandeurs généralement et j'aime bien expliquer aux personnes qui prennent le temps de m'aider, ce qui me semble normal non?)
Un cercle de couleur autour du numéro me convient parfaitement.
Je vais essayer vos méthodes et si j'ai un problème je reviens vers vous.
Merci

[jeanpierre]

Pour saluer les amis du fils, Fred et Spit, le forum et JJ1,

Non, il est vrai que ta demande n'évolue pas, enfin pas de trop.... ???????!!!!!!!!!! (tout de même du style poupée russe)

Nous ne sommes pas les premiers demandeurs, le premier demandeur c'est toi, tu poses une question, ensuite, nous sommes obligés de demander des expliquations, c'est différent.....
Je lis : "et j'aime bien expliquer aux personnes qui prennent le temps de m'aider,", ben, c'est au début qu'il faut le faire, mais pas à la fin.....

Si la question est, ou était, bien posée dés le départ, il n'y aurait aucun autre questionnement ensuite... simplement une ou plusieurs réponses... adaptées...