Определение размеров Shape

[Я_Алешко]

Добрый день. Увяз в головоломке-может кто помочь сможет.

Задача: Нужно определить сколько будет занимать Shape с текстом(текст не постоянный) по высоте. Для дальнейших операций. Работа с документом word ведется из Lotus Notes.

1) Работал над следующей идеей:
а) создаем Shape с начальными(высоту задаю любую) размерами
б) ставим Shape.TextFrame.Autosize=true
в) считываем новый Shape.Height
Загвоздка возникла в следующем: новые размеры я получаю только, если перед пунтом в поставить Sleep на 2-3 секунды

Код:

text1= "ЛИСТ СОГЛАСОВАНИЯ"
TextOrientation=msoTextOrientHorizo ntal
lefft=Point(2.5)
top=point(2.5)
widtth=Point(17)
height=point(2.5)
Set MyShape = wordDoc.Shapes.AddTextbox(TextOrien tation, Lefft,Top,Widtth,Height)
MyShape.Fill.Transparency = 1 'прозрачность фона
MyShape.Line.Transparency = 1 'прозрачность границ textbox'a
MyShape.TextFrame.AutoSize=True Включаю AutoSize
MyShape.TextFrame.TextRange.Font.Na me = "Times New Roman"
MyShape.TextFrame.TextRange.Paragra phs(1).Alignmen t=1
MyShape.TextFrame.TextRange.Font.Si ze=14
MyShape.TextFrame.TextRange.Paragra phs.LineSpacing Rule=1
Вставляю текст
MyShape.TextFrame.TextRange.Text =text1
If text2<>"" Then
MyShape.TextFrame.TextRange.InsertP aragraphAfter
MyShape.TextFrame.TextRange.Paragra phs(2).Alignmen t=3
MyShape.TextFrame.TextRange.InsertA fter(text2)
End If
не помогает даже переполучение объектов
Set MyShape=Nothing
Set MyShape=wordDoc.Shapes(1)
Dim D As Variant
Set D=wordDoc.Shapes(1)

Msgbox Cstr(Myshape.Height) -старое значение
Msgbox Cstr(D.Height) -новое значение
Msgbox Cstr(wordDoc.Shapes(1).height) -новое значение

Может я вообще принципиально не правильно подошел к решению задачи? И есть другие способы?
Или может кто знает как справиться с этим отставанием по времени?

[akokin]

Да, чудно происходит. Устанавливаешь авторазмер для надписи и получить размеры текстового блока уже не удается - их просто нет для автофигуры.
Я попробовал вот такой макрос и вроде бы получаю высоту и ширину автофигуры в пикселях (при добавление фигуры там задаются размеры в пунктах).
Не знаю, верно ли это и поможет ли вам, но попробуйте.

Sub shapeH()
Dim strText As String
Dim oShapeRng As ShapeRange
Dim oFrm As TextFrame

strText = "ЛИСТ СОГЛАСОВАНИЯ"
ActiveDocument.Shapes.AddShape(msoShapeRectangle, 50, 50, 200, 100).Name = "oShape"
Set oShapeRng = ActiveDocument.Shapes.Range("oShape")
Set oFrm = oShapeRng.TextFrame

Application.ScreenUpdating = False
With oFrm
   .AutoSize = True
   .WordWrap = False
   .Orientation = msoTextOrientationHorizontal
   .TextRange.Text = strText
End With

Application.ScreenRefresh
Application.ScreenUpdating = True

MsgBox oShapeRng.Height
MsgBox oShapeRng.Width

End Sub

[Я_Алешко]

Все добрый день! И спасибо за совет! Но я разобрался сам!
Вроде так:
Авторасширение -процесс, я так понимаю, асинхронный и в обычном режиме происходит постепенно.
Чтобы расширение происходило сразу надо обновить картинку на экране методом
Application.ScreenRefresh

И это не зависит от пуктов или других единиц