Добрый день.
Помогите пожалуйста.
На данном форуме нашел макрос по расстановки размеров, хотел бы получить немного другой результат...
Вопрос заключается в следующим; каким образом установить полученные данные высоты и ширины в определенное место, а не в центр фигуры?
Во вложении желаемое место их расположения...
Заранее благодарен.
Пока макрос выглядит так....
Sub razmer_po_centru()
ActiveDocument.Unit = cdrMillimeter
Set OrigSelection = ActiveSelectionRange
For Each s2 In OrigSelection
Dim sh As ShapeRange, w#, h#, s As Shape, s1 As Shape
s2.GetSize w, h
Set s = ActiveDocument.ActiveLayer.CreateParagraphText(1, 1, 0, 0, "", cdrRussian, cdrCharSetRussian, , 12, cdrUndefined, , , cdrCenterAlignment) 'sozdanie textovogo okna
Set t = s.text
t.Story.InsertAfter (h & " mm ")
t.ConvertToArtistic
s.Rotate 90#
s.Fill.UniformColor.CopyAssign s2.Outline.Color
ActiveDocument.CreateShapeRangeFromArray(s2, s).AlignAndDistribute 0, 0, 0, 0, False, 2
s2.Ungroup
Set s1 = ActiveDocument.ActiveLayer.CreateParagraphText(1, 1, 0, 0, "", cdrRussian, cdrCharSetRussian, , 12, cdrUndefined, , , cdrCenterAlignment) 'sozdanie textovogo okna
Set t1 = s1.text
t1.Story.InsertAfter (w & " mm ")
t1.ConvertToArtistic
s1.Fill.UniformColor.CopyAssign s2.Outline.Color
ActiveDocument.CreateShapeRangeFromArray(s2, s, s1).AlignAndDistribute 3, 3, 0, 0, False, 2
s2.Ungroup
Next s2
End Sub
Помогите пожалуйста.
На данном форуме нашел макрос по расстановки размеров, хотел бы получить немного другой результат...
Вопрос заключается в следующим; каким образом установить полученные данные высоты и ширины в определенное место, а не в центр фигуры?
Во вложении желаемое место их расположения...
Заранее благодарен.
Пока макрос выглядит так....
Sub razmer_po_centru()
ActiveDocument.Unit = cdrMillimeter
Set OrigSelection = ActiveSelectionRange
For Each s2 In OrigSelection
Dim sh As ShapeRange, w#, h#, s As Shape, s1 As Shape
s2.GetSize w, h
Set s = ActiveDocument.ActiveLayer.CreateParagraphText(1, 1, 0, 0, "", cdrRussian, cdrCharSetRussian, , 12, cdrUndefined, , , cdrCenterAlignment) 'sozdanie textovogo okna
Set t = s.text
t.Story.InsertAfter (h & " mm ")
t.ConvertToArtistic
s.Rotate 90#
s.Fill.UniformColor.CopyAssign s2.Outline.Color
ActiveDocument.CreateShapeRangeFromArray(s2, s).AlignAndDistribute 0, 0, 0, 0, False, 2
s2.Ungroup
Set s1 = ActiveDocument.ActiveLayer.CreateParagraphText(1, 1, 0, 0, "", cdrRussian, cdrCharSetRussian, , 12, cdrUndefined, , , cdrCenterAlignment) 'sozdanie textovogo okna
Set t1 = s1.text
t1.Story.InsertAfter (w & " mm ")
t1.ConvertToArtistic
s1.Fill.UniformColor.CopyAssign s2.Outline.Color
ActiveDocument.CreateShapeRangeFromArray(s2, s, s1).AlignAndDistribute 3, 3, 0, 0, False, 2
s2.Ungroup
Next s2
End Sub