Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Correspondance des coins cel et rectangle

7 réponses
Avatar
Jacquouille
Bonjour,
Je sélectionne G25 et j'essaie d'y mettre un rectangle.
Comment puis-je modifier cette prose pour que les coins du rectangle
correspondent avec ceux de la cel, svp?

Merci et bonne fin de journée
---------------------------------
Sub Cadre_coin_cel()
Range("G25").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 432.6, 366#, 71.4,
15#). Select
Selection.Characters.Text = "ok"
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("G27").Select
End Sub
--------------
Jacques,Xl MMIII
" Le vin est au repas ce que le parfum est à la femme."
.

7 réponses

Avatar
Michd
Bonjour,
Un exemple :
'----------------------------------------------------------------
Sub Cadre_coin_cel()
Dim Sh As Worksheet
Set Sh = ActiveSheet
With Sh
With .Shapes.AddShape(msoShapeRectangle, 432.6, 366#, 71.4, 15)
x = Feuil1.Range("G25").Left
.OLEFormat.Object.Left = Sh.Range("G25").Left
.Width = Sh.Range("G25").Width
.Height = Sh.Range("G25").Height
.Top = Sh.Range("G25").Top
With .OLEFormat.Object
.Text = "OK"
With .Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
End With
End With
End Sub
'----------------------------------------------------------------
MichD
Avatar
Jacquouille
Bonsoir Denis
Que dire, si ce n'est "parfait".
Mon neurone semble vouloir me souffler dans l'oreille un truc avec CTRL...
pointer le coin, +CTRL et amener manuellement le rectangle????
cela ne te dit rien?
Mais, quoi qu'il en soit, cela ne remplace pas la macro que tu viens de me
donner.
Encore merci
Jacques, XL XXIII
" Le vin est au repas ce que le parfum est à la femme."
.
"Michd" a écrit dans le message de groupe de discussion :
p1brke$fd4$
Bonjour,
Un exemple :
'----------------------------------------------------------------
Sub Cadre_coin_cel()
Dim Sh As Worksheet
Set Sh = ActiveSheet
With Sh
With .Shapes.AddShape(msoShapeRectangle, 432.6, 366#, 71.4, 15)
x = Feuil1.Range("G25").Left
.OLEFormat.Object.Left = Sh.Range("G25").Left
.Width = Sh.Range("G25").Width
.Height = Sh.Range("G25").Height
.Top = Sh.Range("G25").Top
With .OLEFormat.Object
.Text = "OK"
With .Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End With
End With
End With
End Sub
'----------------------------------------------------------------
MichD
Avatar
Michd
Si tu laisses enfoncer le bouton droit de la souris après la sélection d'un
objet, tu peux le déplacer avec facilité jusqu'à sa destination finale. Dans
un second temps, tu enfonces la touche ALT à côté de la barre d'espacement
et avec la souris tu peux redimensionner la taille de l'objet aux dimensions
de la cellule aisément, et ce, pour chacun des côtés du textbox ou
rectangle. Si tu appuies sur la touche Ctrl pendant la sélection de l'objet,
si tu tentes de déplacer l'objet, tu vas créer un doublon de l'objet.
P.S. Dans la procédure suggérée, prière d'enlever cette ligne de code
totalement inutile.
x = Feuil1.Range("G25").Left
MichD
Avatar
isabelle
salut Jacques, salut la communauté,
une autre possibilité,
Sub Cadre_cellule()
Dim Sh As Worksheet, Rng As Range
Dim l As Integer, w As Integer, h As Integer, t As Integer
Set Sh = ActiveSheet
Set Rng = Sh.Range("G2")
With Rng
.Value = "blabla" ' pour inscrire le texte dans la cellule
l = .Left
t = .Top
w = .Width
h = .Height
End With
With Sh
With .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
.Fill.Visible = msoFalse
End With
End With
End Sub
isabelle / décompte 12
Le 2017-12-19 à 13:57, Jacquouille a écrit :
Bonjour,
Je sélectionne G25 et j'essaie d'y mettre un rectangle.
Comment puis-je modifier cette prose pour que les coins du rectangle
correspondent avec ceux de la cel, svp?
Merci et bonne fin de journée
---------------------------------
Sub Cadre_coin_cel()
   Range("G25").Select
       ActiveSheet.Shapes.AddShape(msoShapeRectangle, 432.6, 366#, 71.4, 15#).
Select
   Selection.Characters.Text = "ok"
   With Selection.Characters(Start:=1, Length:=2).Font
       .Name = "Arial"
       .FontStyle = "Normal"
       .Size = 12
       .Strikethrough = False
       .Superscript = False
       .Subscript = False
       .OutlineFont = False
       .Shadow = False
       .Underline = xlUnderlineStyleNone
       .ColorIndex = xlAutomatic
   End With
   Range("G27").Select
End Sub
--------------
Jacques,Xl MMIII
" Le vin est au repas ce que le parfum est à la femme."
.
Avatar
isabelle
oups, j'oubliais l'épaisseur et la couleur du trait,
Sub Cadre_cellule()
Dim Sh As Worksheet, Rng As Range
Dim l As Integer, w As Integer, h As Integer, t As Integer
Set Sh = ActiveSheet
Set Rng = Sh.Range("G2")
With Rng
.Value = "blabla" 'ou rien ici, si la cellule contient déjà le texte
l = .Left
t = .Top
w = .Width
h = .Height
End With
With Sh
With .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
.Fill.Visible = msoFalse
.Line.Weight = 3
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
End With
End Sub
isabelle
Avatar
isabelle
jamais 2 sans 3,
Sub Cadre_cellule()
Dim Sh As Worksheet, Rng As Range
Dim l As Integer, t As Integer, w As Integer, h As Integer
Set Sh = ActiveSheet
Set Rng = Sh.Range("G2")
With Rng
.Value = "blabla" 'enlever cette ligne si la cellule contient déjà le texte
l = .Left
t = .Top
w = .Width
h = .Height
End With
With Sh
With .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
.Fill.Visible = msoFalse
.Line.Weight = 3
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
End With
End Sub
isabelle
Avatar
Jacquouille
Merci Isabelle et Denis.
Je vais profiter des vacances de Noël pour essayer de comprendre tout cela.
grand merci et bonne soirée
Jacques, xl MM III
" Le vin est au repas ce que le parfum est à la femme."
.
"Jacquouille" a écrit dans le message de groupe de discussion :
p1bnf6$88j$
Bonjour,
Je sélectionne G25 et j'essaie d'y mettre un rectangle.
Comment puis-je modifier cette prose pour que les coins du rectangle
correspondent avec ceux de la cel, svp?
Merci et bonne fin de journée
---------------------------------
Sub Cadre_coin_cel()
Range("G25").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 432.6, 366#, 71.4,
15#). Select
Selection.Characters.Text = "ok"
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("G27").Select
End Sub
--------------
Jacques,Xl MMIII
" Le vin est au repas ce que le parfum est à la femme."
.