рисование в висио по команде из EXEL

DArkadiy

как то так выглядят варианты которые точно не работают
:shock:

Цитата:

arrBal (1), visSelect 'compil err
arrBal(1).CellsSRC , visSelect 'err449
appVisio.Select arrBal(1) 'err438
appVisio.Select arrBal(1), visSelect 'err438
appVisio.Select arrBal(1).CellsSRC, visSelect 'err450

DArkadiy

а как просто номер текущего шейпа записать в переменную массива, что бы потом её подставить в "i"

Код:

appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i), visSelect

может это проще будет

Surrogate

DArkadiy писал(а):

может это проще будет

может и проще.
но не стоит плодить сущности без крайней на то необходимости…

Код:

Dim sh1 As Shape, sh2 As Shape, sh3 As Shape
Set sh1 = ActivePage.DrawRectangle(0, 1, 1, 2)
Set sh2 = ActivePage.DrawRectangle(1, 1, 2, 2)
Set sh3 = ActivePage.DrawRectangle(2, 1, 3, 2)
ActiveWindow.DeselectAll
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(sh1.ID), visSelect
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(sh2.ID), visSelect
ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(sh3.ID), visSelect
Application.ActiveWindow.Selection.Group

такой код из под визио работает. подозреваю
что из под экселя не работает, т.к. тот ничего не знает за внутреннюю константу Visio - visSelect !
попробуй так appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i), 2

DArkadiy

Код:

Set sh1 = appVisio.ActiveWindow.Page.DrawRectangle(xb1, yb1, xb2, yb2)

вызывает ошибку 13

DArkadiy

что бы не плодить сущности, нужно записать ID шейпа в константу типо "i"
а потом

Код:

appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i), visSelect
appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i-1), visSelect
appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i-2), visSelect

но Я пока не понял как номер шейпа получить

Surrogate

DArkadiy писал(а):

вызывает ошибку 13

мы эту тему обсуждаем уже 1,5 месяца. каждый раз я создаю временные файлы в визио и эксель. на них тестирую код на своем компе. у тебя же живет свой код. ты пытаешься просто воткнуть мой код с форума. получаются у нас "гранаты не той системы"

DArkadiy писал(а):

что бы не плодить сущности, нужно записать ID шейпа в константу типо "i"

зачем нам эта константа ? я просто имел в виду некоторое число.

DArkadiy писал(а):

но Я пока не понял как номер шейпа получить

DArkadiy писал(а):

appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i), visSelect
appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i-1), visSelect
appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(i-2), visSelect

кстати совсем не факт, что такое прокатит с i-1, i-2

DArkadiy писал(а):

Dim arrBal(1 To 3) As Object
...
Set arrBal(1) = appVisio.ActiveWindow.Page.DrawRectangle(xb1, yb1, xb2, yb2)
…
appVisio.Select Application.ActiveWindow.Page.Shapes.ItemFromID(arrBal(1).ID), 2

попробуй так

DArkadiy

думаю самый простой вариант это добавить сюда этот самый файл экселя...
если будут предложения как рисовать во вставленном на лист объекте висио, будет круто

Tumanov

А так же, как и в обычном Visio.
Нужно только добраться до документа. Это делается примерно так:

Код:

Sub ttt()
    Dim doc As Visio.Document
    Set doc = ActiveSheet.Shapes("Object 1156").DrawingObject.Object
    Debug.Print doc.Pages(1).Name
    Debug.Print doc.Pages(1).Shapes.Count
End Sub

Этот код выводит в Immediate:

Код:

Страница-1
 53 

Естественно, ActiveSheet.Shapes("Object 1156") - это специфично для данного файла. В другом файле имя может быть другим.

DArkadiy

Tumanov, я имел в виду вставленном объекте висио на лист экселя
в данном случае ексель говорит об этом =ВНЕДРИТЬ("Visio.Drawing.11";"")

если Вы тоже, то я пока не понял :shock:

Surrogate

тут вопрос скорее к знатокам Excel, как передавать команды внедренному объекту

Shishok

Как-то так:

Код:

Sub www()

Dim OLEObjVisio As Object
Set OLEObjVisio = ActiveSheet.OLEObjects(1)
OLEObjVisio.Activate

Dim doc As Visio.Document
Set doc = ActiveSheet.Shapes("Object 1156").DrawingObject.Object

doc.Pages(1).DrawRectangle 1, 4, 4, 1 ' рисуем прямоугольник


End Sub

Tumanov

В том файле. который Вы выложили есть такой встроенный объект.
Как я понял, Вы собираетесь что-то рисовать прямо в этом встроенном объекте.
Значит нужно: 1 - влезть в этот объект; 2 - уметь выполнять в нем функции работы с шейпами.
1.
Добраться до объекта можно через коллекцию ActiveSheet.Shapes по имени объекта. У Вас это имя получилось "Object 1156".
Но сам объект мало интересен, нужно найти что-то похожее на объектную модель Visio. (А дальше мы уже знаем, что делать). Вот это "что-то похожее" есть документ Visio. Мы адресуемся к нему как

Код:

Set doc = ActiveSheet.Shapes("Object 1156").DrawingObject.Object

Теперь объект doc - это уже знакомый объект Visio.Document.
С первой частью все.
2.
Как обращаться с шейпами, я не стал расписывать. Это делается как обычно.
А для примера вставил вывод в отладочное окно имени первой страницы документа и количества шейпов на этой странице

Код:

    Debug.Print doc.Pages(1).Name
    Debug.Print doc.Pages(1).Shapes.Count

То есть в выложенном Вами файле во встроенном объекте Visio на первой странице имеется 53 шейпа.

Surrogate

вот мои потуги

Код:

Dim shs As Shapes, sh As Shape
' коллекция шейпов
Set shs = ActiveSheet.Shapes
' перебор шейпов
For i = 1 To shs.Count
Set sh = shs.Item(i)
' проверка на внедренный объект
If sh.Type = msoEmbeddedOLEObject Then ID = i
Next
' активация внедренного объекта
ActiveSheet.Shapes(ID).Select
' в данном примере ID = 12
Selection.Verb Verb:=xlOpen
....
' а что должно быть здесь - я не знаю?
....
' активация эксель
Selection.Verb Verb:=xlPrimary

Tumanov

Я не уверен, что ActiveSheet.Shapes - это единственный путь доступа к внедренному объекту. Просто таким образом до него добрался макрорекордер, ну и я пошел по тому же пути

Кстати, активировать внедренный объект, как мне кажется, совершенно не обязательно. Рисовать можно и так.

Shishok

Цитата:

Кстати, активировать внедренный объект, как мне кажется, совершенно не обяхательно. Рисовать можно и так.

Лично у меня, если хотя-бы разок не активировать объект, то выдает ошибку.

Surrogate

Surrogate писал(а):

' а что должно быть здесь - я не знаю?

сразу не догадался, через GetObject отловить сессию Visio

нарисовал линию внутри внедренного визио документа и сохранил изменения

Код:

Dim v As Visio.Application
Dim shs As Shapes, sh As Shape
Dim w As Window, sl As Selection
Set shs = ActiveSheet.Shapes
For i = 1 To shs.Count
Set sh = shs.Item(i)
' проверка на внедренный объект
If sh.Type = msoEmbeddedOLEObject Then ID = i
Next
' активация внедренного объекта
ActiveSheet.Shapes(ID).Select
' в данном примере ID = 12
Selection.Verb Verb:=xlOpen
Set v = GetObject(, "visio.application")
v.ActivePage.DrawLine 0, 0, 11, 11
v.ActiveDocument.Save
v.ActiveDocument.Close
v.Application.Quit
' активация эксель. не знаю как убить Selection. тупо активировал другую ячейку
Range("A1").Select

DArkadiy

Surrogate, круто
заменил

Код:

appVisio.ActiveWindow.Page.DrawRectangle xf1 - sh_r - 5, yf1, xf2 - sh_r - 5, yf2

на

Код:

v.ActivePage.DrawRectangle xf1 - sh_r - 5, yf1, xf2 - sh_r - 5, yf2

а как заменить

Код:

appVisio.ActiveWindow.Selection.PrimaryItem.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"

и

Код:

appVisio.ActiveWindow.Page.Drop appVisio.Documents.Item("Размеры (техника).vss").Masters.ItemU("Horizontal"), x1 - sh_r - 5, y1 + (l / 25.4)

а то у меня явно, что то не то с синтаксисом

Shishok

Поменяй appVisio на v.
Закомментируй - вот это:

Код:

v.Application.Quit

Удали из документа Visio пустой макрос и модуль.

Surrogate

DArkadiy писал(а):

Код:

appVisio.ActiveWindow.Selection.PrimaryItem.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"

и

Код:

appVisio.ActiveWindow.Page.Drop appVisio.Documents.Item("Размеры (техника).vss").Masters.ItemU("Horizontal"), x1 - sh_r - 5, y1 + (l / 25.4)

а то у меня явно, что то не то с синтаксисом

чтоб этого избежать лично я не экономлю строки

Код:

set shp = appVisio.ActiveWindow.Selection.PrimaryItem
shp.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"

разношу такие вещи в две строки. чтоб сначала определить переменную, а потом присвоить ей значение !

Код:

appVisio.ActiveWindow.Page.Drop appVisio.Documents.Item("Размеры (техника).vss").Masters.ItemU("Horizontal"), x1 - sh_r - 5, y1 + (l / 25.4)

предпочитаю сначала вычислить значения координат куда бросать шейп из мастера

Код:

Dim px as Single, px as Single
px = x1 - sh_r - 5
py =  y1 + (l / 25.4)
v.ActivePage.Drop v.Documents.Item("Размеры (техника).vss").Masters.ItemU("Horizontal"), px, py

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

Shishok

DArkadiy. Причесал немного твой код:

Форум пользователей Visio

Правила форума

рисование в висио по команде из EXEL

Кто сейчас на конференции