Correspondance des coins cel et rectangle

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

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$1@gioia.aioe.org...

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

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

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."
.

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

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

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$1@gioia.aioe.org...

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."
.