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

Форум по вопросам применения и программирования в Visio
Текущее время: 22 янв 2021, 07:17

Часовой пояс: UTC + 3 часа [ Летнее время ]


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


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)
Размещая ваши вложения на форуме не используйте имена файлов содержащих кириллицу, в противном случае файл будет иметь имя .<расширение файла> !
Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 11 ] 
Автор Сообщение
 Заголовок сообщения: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 24 окт 2012, 02:38 
Не в сети
Новичок

Зарегистрирован: 17 апр 2012, 18:04
Сообщений: 25
Очков репутации: 6

Добавить очки репутацииУменьшить очки репутации
Действие аналогично инструменту "кисть", только касается исключительно секции Prop.*
Подробное описание в секции комментариев в коде.
Код:
Private Sub CopyProp() 'Распространить свойства секции Prop
'Свойства распространяются с первого выделенного элемента
'на любое количество вторичных выделенных элементов.
'Строки свойств идентифицируются по имени. Если строка во вторичном отсутствует,
'она создается и заполняется значениями. Обратная связь отсутствует.
'Если строка существует, переписываются все значения.
'Строки вторичного, отсутствующие в первичном остаются без изменений
''На перспективу: Добавить выбор
''1. изменить значения существующих строк при совпадении имен
''2. Копировать также и структуру (существующий вариант)
Dim vsoSel As Visio.Selection
Dim vsoShpFst As Visio.Shape
Dim vsoShpSec As Visio.Shape
Dim vsoCellF As Visio.Cell, vsoCellS As Visio.Cell
Dim vsoRow As Visio.Row
Dim iRF%, iRS%, iTotCount%, stMsgTot$, intSecShp%, booISeeClone As Boolean
Set vsoSel = ActiveWindow.Selection
    If vsoSel.Count < 2 Then
    MsgBox "Для завершения операции необходимо выделить как минимум два объекта! Операция прервана.", vbCritical + vbOKOnly, "Error"
    Exit Sub
    End If
Set vsoShpFst = vsoSel(1)
For intSecShp = 2 To vsoSel.Count 'Перебор выделенных элементов (вторичных)
iTotCount = 0
Set vsoShpSec = vsoSel(intSecShp)
    For iRF = 0 To vsoShpFst.RowCount(visSectionProp) - 1 'Перебор строк секции Prop первичного элемента
    Set vsoCellF = vsoShpFst.CellsSRC(visSectionProp, iRF, 0)
    booISeeClone = False
        For iRS = 0 To vsoShpSec.RowCount(visSectionProp) - 1 'Перебор строк вторичного элемента
        Set vsoCellS = vsoShpSec.CellsSRC(visSectionProp, iRS, 0)
            If vsoCellS.RowName = vsoCellF.RowName Then
            booISeeClone = True
            Exit For
            End If
        Next
    If booISeeClone = False Then 'Если строки во вторичном с таким именем не существует, то
    vsoShpSec.AddRow visSectionProp, vsoShpSec.RowCount(visSectionProp) + 1, visTagDefault 'Создать строку
    j = vsoShpSec.RowCount(visSectionProp) - 1 'И задать номер этой строки, иначе используется номер строки из цикла перебора имен во вторичном элементе
    vsoShpSec.CellsSRC(visSectionProp, j, 0).RowName = vsoCellF.RowName
    iTotCount = iTotCount + 1
    Else
    j = iRS
    End If
        For Z = 0 To vsoShpSec.RowsCellCount(visSectionProp, iRS) ' Перебор ячеек и запись значений в них
        Set vsoCellS = vsoShpSec.CellsSRC(visSectionProp, j, Z)
        Set vsoCellF = vsoShpFst.CellsSRC(visSectionProp, iRF, Z)
        vsoCellS.FormulaU = vsoCellF.FormulaU
        Next
    Next
stMsgTot = stMsgTot + vsoShpSec.NameU + Chr(32) + "добавлено строк свойств: " & iTotCount & Chr(13)
Next
MsgBox stMsgTot
End Sub

Если есть вопросы, замечания или предложения, с интересом выслушаю.
Есть возможность работы с любой секцией, достаточно заменить константу visSectionProp на нужную вам, код останется работоспособный. (спасибо 9ray за комментарий!)

_________________
F1, ObjectBrowser и Artberg Вам в помощь!


Последний раз редактировалось dfolk 24 окт 2012, 11:12, всего редактировалось 1 раз.

Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование пользовательских свойств фигур (секция UserProp)
СообщениеДобавлено: 24 окт 2012, 06:42 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 927
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 125

Добавить очки репутацииУменьшить очки репутации
на самом деле в визио уже есть подобный функционал, называется "наборы данных фигур". сделал видео (gif) с примером, приложил:

Вложение:
Комментарий к файлу: пример использования Custom Properties Sets
vis.gif
vis.gif [ 1.59 Mб | Просмотров: 1443 ]


макрос безусловно полезный, если его доработать под свои нужды.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование пользовательских свойств фигур (секция UserProp)
СообщениеДобавлено: 24 окт 2012, 06:46 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 927
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 125

Добавить очки репутацииУменьшить очки репутации
пардон, не заметил сразу что секция то User!
:oops:
тогда спасибо еще раз)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование пользовательских свойств фигур (секция UserProp)
СообщениеДобавлено: 24 окт 2012, 11:05 
Не в сети
Новичок

Зарегистрирован: 17 апр 2012, 18:04
Сообщений: 25
Очков репутации: 6

Добавить очки репутацииУменьшить очки репутации
Спасибо за видео! Никогда не пользовался таким способом, буду знать.
Секция все же Shape data. Сейчас подправлю в сообщении, чтобы не было путаницы.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 24 окт 2012, 11:23 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 927
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 125

Добавить очки репутацииУменьшить очки репутации
можно переделать макрос так, чтобы копировались сразу обе секции Prop и User. такого функционала в визио нет. было бы полезно


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 24 окт 2012, 13:20 
Не в сети
Новичок

Зарегистрирован: 17 апр 2012, 18:04
Сообщений: 25
Очков репутации: 6

Добавить очки репутацииУменьшить очки репутации
Я думаю, с такими доработками трудностей не возникнет . Я бы реализовал это так:
Вместо Sub использовал бы Function, передавал бы в нее параметр типа Integer, в параметре бы указывал код секции, с которой работаем (коды секций можно посмотреть в VBA->ObjectBrowser-> Класс "VisSectionIndices") Нужно обработать несколько секций - запускаешь функцию несколько раз с нужным параметром, зато в самом коде изменений по-минимуму.

_________________
F1, ObjectBrowser и Artberg Вам в помощь!


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 24 окт 2012, 13:23 
Не в сети
Глав-тролль

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 4078
Откуда: оттуда
Использую Visio c: 1998
Уровнь квалификации: Отсутствует
я примерно так и сделал, где 242 код секции User, 243 - Prop
Код:
Private Sub CopyProp() 'Распространить свойства секции Prop
'Свойства распространяются с первого выделенного элемента
'на любое количество вторичных выделенных элементов.
'Строки свойств идентифицируются по имени. Если строка во вторичном отсутствует,
'она создается и заполняется значениями. Обратная связь отсутствует.
'Если строка существует, переписываются все значения.
'Строки вторичного, отсутствующие в первичном остаются без изменений
''На перспективу: Добавить выбор
''1. изменить значения существующих строк при совпадении имен
''2. Копировать также и структуру (существующий вариант)
Dim vsoSel As Visio.Selection
Dim vsoShpFst As Visio.Shape
Dim vsoShpSec As Visio.Shape
Dim x As Integer
Dim vsoCellF As Visio.Cell, vsoCellS As Visio.Cell
Dim vsoRow As Visio.Row
Dim iRF%, iRS%, iTotCount%, stMsgTot$, intSecShp%, booISeeClone As Boolean
Set vsoSel = ActiveWindow.Selection
    If vsoSel.Count < 2 Then
    MsgBox "Для завершения операции необходимо выделить как минимум два объекта! Операция прервана.", vbCritical + vbOKOnly, "Error"
    Exit Sub
    End If
Set vsoShpFst = vsoSel(1)
For intSecShp = 2 To vsoSel.Count 'Перебор выделенных элементов (вторичных)
iTotCount = 0
Set vsoShpSec = vsoSel(intSecShp)
For x = 242 To 243
    For iRF = 0 To vsoShpFst.RowCount(x) - 1 'Перебор строк секции Prop первичного элемента
    Set vsoCellF = vsoShpFst.CellsSRC(x, iRF, 0)
    booISeeClone = False
        For iRS = 0 To vsoShpSec.RowCount(x) - 1 'Перебор строк вторичного элемента
        Set vsoCellS = vsoShpSec.CellsSRC(x, iRS, 0)
            If vsoCellS.RowName = vsoCellF.RowName Then
            booISeeClone = True
            Exit For
            End If
        Next iRS
    If booISeeClone = False Then 'Если строки во вторичном с таким именем не существует, то
    vsoShpSec.AddRow x, vsoShpSec.RowCount(x) + 1, visTagDefault 'Создать строку
    j = vsoShpSec.RowCount(x) - 1 'И задать номер этой строки, иначе используется номер строки из цикла перебора имен во вторичном элементе
    vsoShpSec.CellsSRC(x, j, 0).RowName = vsoCellF.RowName
    iTotCount = iTotCount + 1
    Else
    j = iRS
    End If
        For Z = 0 To vsoShpSec.RowsCellCount(x, iRS) ' Перебор ячеек и запись значений в них
        Set vsoCellS = vsoShpSec.CellsSRC(x, j, Z)
        Set vsoCellF = vsoShpFst.CellsSRC(x, iRF, Z)
        vsoCellS.FormulaU = vsoCellF.FormulaU
        Next Z
    Next iRF
    Next x
stMsgTot = stMsgTot + vsoShpSec.NameU + Chr(32) + "добавлено строк свойств: " & iTotCount & Chr(13)
Next
MsgBox stMsgTot
End Sub


PS давно собирался сделать код который будет копировать несколько секций: User, Prop, Actions, Scratch. Благодаря dfolk я сделаю это быстрее :)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: может у кого из вас есть celMaker ?
СообщениеДобавлено: 30 ноя 2012, 14:53 
Не в сети
Глав-тролль

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 4078
Откуда: оттуда
Использую Visio c: 1998
Уровнь квалификации: Отсутствует
Для тех кому лень морочиться с макросами есть готовое решение

celMaker copies Visio custom properties, user-defined cells and actions to and from Excel.
Microsoft Office Visio shape developers often need to copy custom properties, user-defined cells, actions and connection points from one master to another.
celMaker is a developers tool that allows selected ShapeSheet™ sections to be documented, verified, enhanced and propagated from one Visio master to another, including the migration of complex formulae. Current version supports Custom Properties, User-defined cells, Actions, Connection Points and SmartTags*.

* Visio 2003 only



Одна проблема нигде не могу скачать :(
может у кого из уважаемых пользователей есть эта приблуда ?


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 30 ноя 2012, 16:13 
Не в сети
Постоянный участник

Зарегистрирован: 11 май 2012, 15:05
Сообщений: 92
Очков репутации: 25

Добавить очки репутацииУменьшить очки репутации
оно? по сслыке launch
http://www.bvisual.net/products/celMaker/publish.htm
даже установилось


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 30 ноя 2012, 17:01 
Не в сети
Глав-тролль

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 4078
Откуда: оттуда
Использую Visio c: 1998
Уровнь квалификации: Отсутствует
спасибо, что-то я ссылку не разглядел ! тоже установил ! шикарно - все работает.
надо только сначала, для получения шаблона таблицы эксель запустить "Visio to Excel".
а c полученной таблицей уже можно делать, что хочешь :)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование данных фигуры (секция ShapeData)
СообщениеДобавлено: 09 окт 2013, 15:40 
Есть возможность работы с любой секцией, достаточно заменить константу visSectionProp на нужную вам, код останется работоспособный. (спасибо 9ray за комментарий!)


Пожаловаться на это сообщение
Вернуться к началу
  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 11 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]



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

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB