Correspondance des coins cel et rectangle

Le
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."
.
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Michd
Le #26456426
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
Jacquouille
Le #26456432
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
Michd
Le #26456436
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
isabelle
Le #26456441
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."
.
isabelle
Le #26456440
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
isabelle
Le #26456442
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
Jacquouille
Le #26456549
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."
.
Publicité
Poster une réponse
Anonyme