2013-04-16 2 views
3

Я пытаюсь добавить фигуру в определенную ячейку, но по какой-то причине не может получить форму, добавленную в нужное место. Ниже приведен код, я использую, чтобы добавить форму:vba, чтобы добавить форму в определенную ячейку в Excel

Cells(milestonerow, enddatecellmatch.Column).Activate 

Dim cellleft As Single 
Dim celltop As Single 
Dim cellwidth As Single 
Dim cellheight As Single 

cellleft = Selection.Left 
celltop = Selection.Top 

ActiveSheet.Shapes.AddShape(msoShapeOval, cellleft, celltop, 4, 10).Select 

я использовал переменные для захвата верхней и левой позиции, чтобы проверить значения, которые были установлены в моем коде против значений я видел при добавлении формы вручную в активном месте при записи макроса. Когда я запускаю свой код, cellleft = 414.75 и celltop = 51, но когда я добавляю форму вручную к активной ячейке при записи макроса, cellleft = 318.75 и celltop = 38.25. Я искал эту проблему некоторое время и просмотрел много существующих вопросов онлайн о добавлении фигур, но я не могу понять это. Любая помощь будет принята с благодарностью.

+0

Приведенный выше код работает абсолютно нормально для меня. –

+0

'.Activate' в первой строке не обязательно означает, что он равен Selection, тогда ... вам нужно его проверить. Или просто измените '.Activate' на' .Select' в первой строке. –

+1

У меня такая же проблема. Существует небольшая разница между .Cell.Left и истинным положением фигуры. Эта «ошибка» встречается только на excel 2007. На excel 2003 код vba работает хорошо. В 2010 году я не знаю. Я пробую Debug.Print, но я не вижу никакого эффекта. – 2013-09-04 14:30:43

ответ

6

Это, кажется, работает для меня. Я добавил операторы отладки в конце, чтобы показать, соответствуют ли фигуры .Top и .Left значениям ячейки .Top и .Left.

Для этого я выбрал ячейку C2.

Shape inserted at cell's top & left

Sub addshapetocell() 

Dim clLeft As Double 
Dim clTop As Double 
Dim clWidth As Double 
Dim clHeight As Double 

Dim cl As Range 
Dim shpOval As Shape 

Set cl = Range(Selection.Address) '<-- Range("C2") 

clLeft = cl.Left 
clTop = cl.Top 
clHeight = cl.Height 
clWidth = cl.Width 

Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, clLeft, clTop, 4, 10) 

Debug.Print shpOval .Left = clLeft 
Debug.Print shpOval .Top = clTop 

End Sub 
+0

Я добавил ваш раздел отладки, и обе формы и ячейки слева и сверху были такими же, поэтому я понятия не имею, почему он не работает. Я сохранил книгу, закрыл Excel, а затем снова открыл ее, а затем работал нормально, поэтому не совсем уверен, в чем проблема, но спасибо за ответ. – Casey

0

я узнал, эта проблема вызвана ошибкой, которая происходит только тогда, когда уровень масштабирования не 100%. В этом случае положение ячейки сообщается неправильно.

Решение для этого - изменить масштаб на 100%, установить позиции, а затем вернуться к исходному масштабированию. Вы можете использовать Application.ScreenUpdatinf для предотвращения мерцания.

Dim oldZoom As Integer 
oldZoom = Wn.Zoom 
Application.ScreenUpdating = False 
Wn.Zoom = 100 'Set zoom at 100% to avoid positioning errors 

    cellleft = Selection.Left 
    celltop = Selection.Top 
    ActiveSheet.Shapes.AddShape(msoShapeOval, cellleft, celltop, 4, 10).Select 

Wn.Zoom = oldZoom 'Restore previous zoom 
Application.ScreenUpdating = True 
Смежные вопросы