Macro for insert oval shape in table cell

Joined
Apr 18, 2013
Messages
2
Reaction score
0
Hi everyone!

I'm building a macro for inserting a oval shape in the current selected cell of a table. That is: the cell isn't selected but the cursor is at the cell where I want to insert the shape.
The thing is that i want it to be placed at an exact point of that cell but the macro doesn't recognize it. It recognizes the page and places the shape in the point I determine but relatively to the page instead of the current cell.
So I have the following code. What's wrong with it?

Thanks to anyone who can help me!
Ricardo

Sub InsWhiteTurn()
'
'Inserir indicador de turno das brancas
'
On Error GoTo ErrorHandler
Set sh = Shapes.AddShape(Type:=msoShapeOval, _
Left:=0, Top:=0, Width:=CentimetersToPoints(0.4), Height:=CentimetersToPoints(0.4), Anchor:=Selection.Cells(3))
With sh
.Line.Weight = 0.75
.Line.ForeColor = vbBlack
.Fill.ForeColor = vbWhite
.WrapFormat.Type = wdWrapFront
.LayoutInCell = True
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.Left = CentimetersToPoints(8)
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.Top = CentimetersToPoints(6.15)
End With
Exit Sub
ErrorHandler:
End Sub

PS: I have open explicit determining my variables.
 
Joined
Apr 18, 2013
Messages
2
Reaction score
0
Ok, after much searching in many forums, i've managed to come out with this code that does what I wan't.
Hope it's useful for somebody else!

Sub InsTurnoBrancas()
'
'Inserir indicador de turno das brancas
'
On Error GoTo ErrorHandler
Set IndTurnBranc = ActiveDocument.Shapes.AddShape(Type:=msoShapeOval, _
Left:=fcnXCoord, Top:=fcnYCoord, Width:=CentimetersToPoints(0.4), Height:=CentimetersToPoints(0.4))
With IndTurnBranc
.Line.Weight = 0.75
.Line.ForeColor = vbBlack
.Fill.ForeColor = vbWhite
.WrapFormat.Type = wdWrapNone
.LockAnchor = True
.LayoutInCell = True
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
End With
Exit Sub
ErrorHandler:
End Sub
Function fcnXCoord() As Double
'I've to sum the 8 centimeters to the point where the cursor is.
fcnXCoord = Selection.Information(wdHorizontalPositionRelativeToPage) + CentimetersToPoints(8)
End Function
Function fcnYCoord() As Double
'I've to subtract the 1.5 centimeters to the point where the cursor is because I've a picture in the cell so the cursor is not on the left upper of the cell, it's after the picture.
fcnYCoord = Selection.Information(wdVerticalPositionRelativeToPage) - CentimetersToPoints(1.5)
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top