Screen Position
This seemed to work pretty well for me:
Option Explicit Sub testme() Dim myShape As Shape Dim HalfHeight As Double Dim HalfWidth As Double Dim myShapeHeight As Double Dim myShapeWidth As Double myShapeHeight = 72 myShapeWidth = 72 With ActiveWindow.VisibleRange HalfHeight = (.Height / 2) - (myShapeHeight / 2) + .Top HalfWidth = (.Width / 2) - (myShapeWidth / 2) + .Left End With With ActiveSheet Set myShape = .Shapes.AddShape(Type:=msoShapeSmileyFace, _ Top:=HalfHeight, Left:=HalfWidth, _ Width:=myShapeWidth, Height:=myShapeHeight) myShape.Name = "shp" & Format(Now, "yyyymmdd_hhmmss") End With End Sub Ronbo wrote: I am trying to create a routine that will put an autoshape in the middle of the screen/window without using an absolute address. It seems simple but I am not finding anything on it. What I have is; ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 756.75, 423.75, 72#, 72#). _ Select What I need is to change the absolute address of 756.75, 423.75 to something like ActiveWindow. Select Top.250 Left.250 ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 72#, 72#) As always any help is appreciated. -- Dave Peterson |
Screen Position
Dave:
It's always great to see the response from a question, coming from one of the qurus. Your programming was PERFECT! Thanks a lot for taking the time and sharing your expertise to provide the code. It is truly appreciated. "Dave Peterson" wrote: This seemed to work pretty well for me: Option Explicit Sub testme() Dim myShape As Shape Dim HalfHeight As Double Dim HalfWidth As Double Dim myShapeHeight As Double Dim myShapeWidth As Double myShapeHeight = 72 myShapeWidth = 72 With ActiveWindow.VisibleRange HalfHeight = (.Height / 2) - (myShapeHeight / 2) + .Top HalfWidth = (.Width / 2) - (myShapeWidth / 2) + .Left End With With ActiveSheet Set myShape = .Shapes.AddShape(Type:=msoShapeSmileyFace, _ Top:=HalfHeight, Left:=HalfWidth, _ Width:=myShapeWidth, Height:=myShapeHeight) myShape.Name = "shp" & Format(Now, "yyyymmdd_hhmmss") End With End Sub Ronbo wrote: I am trying to create a routine that will put an autoshape in the middle of the screen/window without using an absolute address. It seems simple but I am not finding anything on it. What I have is; ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 756.75, 423.75, 72#, 72#). _ Select What I need is to change the absolute address of 756.75, 423.75 to something like ActiveWindow. Select Top.250 Left.250 ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 72#, 72#) As always any help is appreciated. -- Dave Peterson |
Screen Position
Glad it worked the way you wanted.
Ronbo wrote: Dave: It's always great to see the response from a question, coming from one of the qurus. Your programming was PERFECT! Thanks a lot for taking the time and sharing your expertise to provide the code. It is truly appreciated. "Dave Peterson" wrote: This seemed to work pretty well for me: Option Explicit Sub testme() Dim myShape As Shape Dim HalfHeight As Double Dim HalfWidth As Double Dim myShapeHeight As Double Dim myShapeWidth As Double myShapeHeight = 72 myShapeWidth = 72 With ActiveWindow.VisibleRange HalfHeight = (.Height / 2) - (myShapeHeight / 2) + .Top HalfWidth = (.Width / 2) - (myShapeWidth / 2) + .Left End With With ActiveSheet Set myShape = .Shapes.AddShape(Type:=msoShapeSmileyFace, _ Top:=HalfHeight, Left:=HalfWidth, _ Width:=myShapeWidth, Height:=myShapeHeight) myShape.Name = "shp" & Format(Now, "yyyymmdd_hhmmss") End With End Sub Ronbo wrote: I am trying to create a routine that will put an autoshape in the middle of the screen/window without using an absolute address. It seems simple but I am not finding anything on it. What I have is; ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 756.75, 423.75, 72#, 72#). _ Select What I need is to change the absolute address of 756.75, 423.75 to something like ActiveWindow. Select Top.250 Left.250 ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 72#, 72#) As always any help is appreciated. -- Dave Peterson -- Dave Peterson |
All times are GMT +1. The time now is 05:25 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com