C
Chris Bruce
I have an macro to paste shapes onto a worksheet and position them
relative to particular rows. It works fine until tested on a clients
machine running Vista and Excel 2007 when the vertical screen position
of a shape and the range that it sits on are diverging. The left
property is working as expected.
On my clients system, when a shape is placed over a cell, say B600,
and selected, then this test macro is run the highlight cells appear
several rows below the shape.
When the top property reaches 9000 the discrepancy is approximately
160.
I don't have access to another machine running Excel 2007 and I'm
wondering if this is an Excel 2007 'feature' or is it my clients
machine?
Sub test4()
On Error Resume Next
nn = Selection.Name
Set snn = ActiveSheet.Shapes(nn)
ott = snn.Top
oll = snn.Left
ohh = snn.Height
On Error GoTo 0
crr = 0
For r = 1 To 1000
If Cells(r, 2).Top >= ott Then
crr = r - 1
r = 1000
End If
Next r
If crr = 0 Then Exit Sub
Range(Cells(crr, 1), Cells(crr, 4)).Interior.ColorIndex = 22
ctt = Cells(crr, 2).Top
msg = nn _
& vbCrLf & "row = " & crr _
& vbCrLf & "row top = " & ctt _
& vbCrLf & "shape top = " & ott _
& vbCrLf & "shape height = " & ohh
MsgBox msg
Range(Cells(crr, 1), Cells(crr, 4)).Interior.ColorIndex = xlNone
ActiveSheet.Shapes(nn).Top = ott + 10
End Sub
Chris Bruce
relative to particular rows. It works fine until tested on a clients
machine running Vista and Excel 2007 when the vertical screen position
of a shape and the range that it sits on are diverging. The left
property is working as expected.
On my clients system, when a shape is placed over a cell, say B600,
and selected, then this test macro is run the highlight cells appear
several rows below the shape.
When the top property reaches 9000 the discrepancy is approximately
160.
I don't have access to another machine running Excel 2007 and I'm
wondering if this is an Excel 2007 'feature' or is it my clients
machine?
Sub test4()
On Error Resume Next
nn = Selection.Name
Set snn = ActiveSheet.Shapes(nn)
ott = snn.Top
oll = snn.Left
ohh = snn.Height
On Error GoTo 0
crr = 0
For r = 1 To 1000
If Cells(r, 2).Top >= ott Then
crr = r - 1
r = 1000
End If
Next r
If crr = 0 Then Exit Sub
Range(Cells(crr, 1), Cells(crr, 4)).Interior.ColorIndex = 22
ctt = Cells(crr, 2).Top
msg = nn _
& vbCrLf & "row = " & crr _
& vbCrLf & "row top = " & ctt _
& vbCrLf & "shape top = " & ott _
& vbCrLf & "shape height = " & ohh
MsgBox msg
Range(Cells(crr, 1), Cells(crr, 4)).Interior.ColorIndex = xlNone
ActiveSheet.Shapes(nn).Top = ott + 10
End Sub
Chris Bruce