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

Форум по вопросам применения и программирования в Visio
Текущее время: 26 мар 2017, 21:02

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


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


Размещение файлов в формате vsd (а не vsdx/vsdm), увеличивает вероятность ответа стремительным домкратом !!!



Начать новую тему Ответить на тему  [ Сообщений: 66 ]  На страницу Пред.  1, 2, 3, 4  След.
Автор Сообщение
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 14 ноя 2016, 23:38 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Цитата:
Наверное, в Visio можно сделать аналогично.

Можно, конечно:
Код:
Dim oDoc As Visio.Document
Set oDoc = Application.Documents.Add("")
' Код
' Код
oDoc.SaveAs "path\filename.vsd"
oDoc.Close


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 13:06 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Ребята, всё оказалось намного проще!
Читаем внимательно Справку по методам Shape.Copy & Shape.Paste и видим, что у обоих методов, оказывается, есть флаги методов копирования/вставки:
visCopyPasteNormal == 0 - Default value. Shapes are copied/pasted to the center of the active window.
visCopyPasteNoTranslate == 1 - Shapes are copied/pasted to their original coordinate locations
Поэтому никакоая возня с группировкой, правкой формул и разгруппировкой, похоже, НЕ НУЖНА!
Сейчас буду пробовать.
За одно подумаю, как бы поэлегантнее CellsSRC страницы передать новой странице?
Ну не нравится мне поэлементный копипаст :evil:
Тем более, что 8 элементов, боюсь, маловато будет. Надо ещё и ориентацию страницы копировать, и из visRowPageLayout ещё 5 параметров.
В общем, надо попробовать цикл хотя бы присобачить.

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 13:25 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Я смотрю ты глубоко погрузился в объектную модель Visio. :)
По поводу:
Цитата:
За одно подумаю, как бы поэлегантнее CellsSRC страницы передать новой странице?

А это не увидел? http://visio.getbb.ru/viewtopic.php?f=15&t=1047


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 13:53 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
А это не увидел?
Там ссылка на файл на Яндекс.Диске. А я с работы до него не достаю. Но, судя по обсуждению, там копирование по одному параметру. Так я и сам уже когда-то делал. Вот подпрограмма с комментариями из моего старого проекта, в котором изо всех открытых документов листы собирались в один новый:
Спойлер: показать
Код:
Private Sub Copy_Page_SetUp(newPage As Visio.Page, curPage As Visio.Page)
   newPage.Background = curPage.Background
   newPage.BackPage = curPage.BackPage

   ' CellsSRC property returns a Cell object that represents a ShapeSheet cell identified by section, row, and column indices.
   ' objRet = object.CellsSRC (section, row, column)
   ' visSectionObject == 1 -  Stores general non-repeating properties of an object
   ' visRowPage == 10 - Index of the row in visSectionObject that defines page or master properties (shape of type visTypePage).
   ' visRowPrintProperties == 25 Index of the row in visSectionObject of a document that defines printing properties. (Print Properties section in the ShaptSheet window.)
   ' visRowPageLayout == 24 Index of the row in visSectionObject of a page or master that defines placement and routing

   'newPage.PageSheet.CellsSRC(1, 10, visPageWidth).FormulaU = _
    curPage.PageSheet.CellsSRC(1, 10, visPageWidth).FormulaU ' visPageWidth == 0
   newPage.PageSheet.Cells("PageWidth") = curPage.PageSheet.Cells("PageWidth")

   'newPage.PageSheet.CellsSRC(1, 10, visPageHeight).FormulaU = _
    curPage.PageSheet.CellsSRC(1, 10, visPageHeight).FormulaU ' visPageHeight == 1
   newPage.PageSheet.Cells("PageHeight") = curPage.PageSheet.Cells("PageHeight")

   newPage.PageSheet.CellsSRC(1, 10, visPageScale).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 10, visPageScale).FormulaU ' visPageScale == 4

   newPage.PageSheet.CellsSRC(1, 10, visPageDrawingScale).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 10, visPageDrawingScale).FormulaU ' visPageDrawingScale == 5

   newPage.PageSheet.CellsSRC(1, 10, visPageDrawSizeType).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 10, visPageDrawSizeType).FormulaU ' visPageDrawSizeType == 6

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesLeftMargin).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesLeftMargin).FormulaU ' visPrintPropertiesLeftMargin == 0

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesRightMargin).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesRightMargin).FormulaU ' visPrintPropertiesRightMargin == 1

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesTopMargin).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesTopMargin).FormulaU ' visPrintPropertiesTopMargin == 2

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesBottomMargin).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesBottomMargin).FormulaU ' visPrintPropertiesBottomMargin == 3

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesPageOrientation).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesPageOrientation).FormulaU ' visPrintPropertiesPageOrientation == 16

   newPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesPaperKind).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 25, visPrintPropertiesPaperKind).FormulaU ' visPrintPropertiesPaperKind == 17


   newPage.PageSheet.CellsSRC(1, 24, visPLOLineToNodeX).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOLineToNodeX).FormulaU ' visPLOLineToNodeX == 16

   newPage.PageSheet.CellsSRC(1, 24, visPLOBlockSizeX).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOBlockSizeX).FormulaU ' visPLOBlockSizeX == 18

   newPage.PageSheet.CellsSRC(1, 24, visPLOBlockSizeY).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOBlockSizeY).FormulaU ' visPLOBlockSizeY == 19

   newPage.PageSheet.CellsSRC(1, 24, visPLOAvenueSizeX).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOAvenueSizeX).FormulaU ' visPLOAvenueSizeX == 20

   newPage.PageSheet.CellsSRC(1, 24, visPLOAvenueSizeY).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOAvenueSizeY).FormulaU ' visPLOAvenueSizeY == 21

   newPage.PageSheet.CellsSRC(1, 24, visPLOLineToLineY).FormulaU = _
   curPage.PageSheet.CellsSRC(1, 24, visPLOLineToLineY).FormulaU ' visPLOLineToLineY == 23

End Sub
но это монструозно и не красиво! Сейчас думаю, как бы циклами с использованием коллекций или словарей вместо массивов сделать. Благо время сейчас на работе есть.
И, к стати, твою процедурку Duplucate_Here я уже покоцал и протестировал с флагами копи-паста. Только пока ещё красоту не навёл. Отлично работает!
Спойлер: показать
Код:
Sub Duplucate_Here()
   Dim arrPage(7) As String, oPage As Visio.Page, oPage1 As Visio.Page
   Set oPage = ActivePage
   Call GetPageSettings(oPage, arrPage)
   ActiveWindow.SelectAll
   ActiveWindow.Selection.Copy (1)

   Set oPage1 = ActiveDocument.Pages.Add
   Call SetPageSettings(oPage1, arrPage)
   oPage1.Paste (1)

   ActiveWindow.Page = oPage
   ActiveWindow.DeselectAll
   Set oPage = Nothing
   Set oPage1 = Nothing
End Sub

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 14:55 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 774
Очков репутации: 100567

Добавить очки репутацииУменьшить очки репутации
Цитата:
Поэтому никакоая возня с группировкой, правкой формул и разгруппировкой, похоже, НЕ НУЖНА!

Правка формул и группировка - они не на пустом месте появились...
Тупое копирование шейпов - оно проходит для примитивной графики, но начинает ошибаться при наличии формул. Если копируется шейп, ссылающийся на шейп, который еще не скопирован, то формула неизбежно будет искажена. Ну не на что сослаться только что вставленному шейпу.
Так что все упрощения - они могут и выглядеть крутыми и даже тестироваться хорошо... Но только в своей области применения.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 15:13 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Цитата:
Но, судя по обсуждению, там копирование по одному параметру

Что это значит?
Там копирование целыми секциями(разделами). Например за раз копируется вот это все:

Изображение


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 16:15 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
Там копирование целыми секциями(разделами)
Ну я же говорил:
Alex_ST писал(а):
Там ссылка на файл на Яндекс.Диске. А я с работы до него не достаю
Значит, моё предположение о том, что
Alex_ST писал(а):
… судя по обсуждению, там копирование по одному параметру.
оказалось не верным. Из дома вечером посмотрю.
Tumanov писал(а):
Тупое копирование шейпов - оно проходит для примитивной графики
ну, это значит - для меня :)
Значит так: с копированием свойств страницы сейчас пока заниматься не буду.
Займусь копированием не выделяемых по ActiveWindow.SelectAll подложек ( шейпов, у которых .CellsC(visLayerLock)=True ).
Это, похоже, совсем не сложно сделать с использованием словарей.
А уже в конце проекта можно будет попробовать сделать не фиксированное, а динамически изменяемое в зависимости от количества открытых документов меню для выбора Destination. (На Excel у меня это получалось, но в Visio может быть засада с событиями - пока не вник как с ними работать. Посмотрим)

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 15 ноя 2016, 17:38 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Ну вот. Разлочивание слоёв перед копированием и залочивание их обратно сделал
Спойлер: показать
Код:
Sub Duplucate_Here()
   Dim arrPage(7) As String, oPage As Visio.Page, oNewPage As Visio.Page
   Dim xLayer As Visio.Layer
   Dim oDict As Object
   Set oDict = CreateObject("Scripting.Dictionary")
   For Each xLayer In ActiveWindow.Page.Layers   ' UnLock слоёв с запоминанием их индексов и имён в словаре
      With xLayer
         If .CellsC(visLayerLock) Then oDict.Item(.Index) = .Name: .CellsC(visLayerLock) = 0
      End With
   Next xLayer

   Set oPage = ActivePage
   ' ====== копирование рисунков =========
   ActiveWindow.SelectAll
   ActiveWindow.Selection.Copy (1)
   ActiveWindow.DeselectAll
   For Each xLayer In ActiveWindow.Page.Layers      ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Index) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer

   ' ====== новая страница в текущем документе =========
   Set oNewPage = ActiveDocument.Pages.Add   ' после создания страница АКТИВИЗИРУЕТСЯ !!!
   Call GetPageSettings(oPage, arrPage)   ' запомнить установки копируемой страницы
   Call SetPageSettings(oNewPage, arrPage)

   oNewPage.Paste (1)
   For Each xLayer In ActiveWindow.Page.Layers   ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Index) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer

   ActiveWindow.Page = oPage
   Set oPage = Nothing
   Set oNewPage = Nothing
   Set oDict = Nothing
End Sub
Процедуры GetPageSettings и SetPageSettings завтра объединю в одну CopyPageSettings

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


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

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok,
Копаясь с копированием листа и не видя твою (т.к. ЯД с работы закрыт собаками-сисадминами :evil: ), я написал такую процедуру копирования свойств листов:
Спойлер: показать
Код:
Private Sub Duplicate_Page_CellsSRC(oPageFrom As Visio.Page, oPageTo As Visio.Page)
   Dim arSection(): arSection = Array(visSectionObject)
   Dim arRow(): arRow = Array(visRowPage, visRowPrintProperties, visRowPageLayout)
   Dim iSection, iRow, iColumn
   For Each iSection In arSection
      For Each iRow In arRow
         For iColumn = 0 To 255
            On Error Resume Next
            oPageTo.PageSheet.CellsSRC(iSection, iRow, iColumn) = oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
            'Debug.Print oPageFrom.Name & "CellsSRC(" & iSection & "," & iRow & "," & iColumn & ").FormulaU = " & oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
         Next iColumn
      Next iRow
   Next iSection
End Sub
Главное преимущество, ИМХО, - "всё в одном" без усложнения вызовом других процедур.
И к тому же при необходимости работы с другими объектами копируемые секции и ряды элементарно можно либо просто изменить в коде, либо переделать процедуру в универсальную, добавив ей в аргументы массивы сканируемых параметров, а не задавая их внутри.

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


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

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Ну приблизительно и у меня так же.
Но это только для, так сказать , штатных секций страницы.
А вот Shape Data, User Defined Cells, Scratch, Actions, Hyperlinks и Layers - это отдельная песня. Ну может оно тебе и не надо.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 13:42 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Alex_ST писал(а):
Процедуры GetPageSettings и SetPageSettings завтра объединю в одну CopyPageSettings
Переделал.
Кроме того, обнаружил, что .Index у слоя может измениться при копировании и потому не правильно восстановиться из словаря. Переделал на запоминание в словаре .Name залоченных слоёв.
Вроде бы работает. Проверьте кто-нибудь ещё, пожалуйста.
Duplucate_Here
Спойлер: показать
Код:
Sub Duplucate_Here()
   Dim arrPage(7) As String
   Dim oPage As Visio.Page, oNewPage As Visio.Page
   Dim xLayer As Visio.Layer
   Dim oDict As Object
   Set oDict = CreateObject("Scripting.Dictionary")
   For Each xLayer In ActiveWindow.Page.Layers   ' UnLock слоёв с запоминанием их индексов и имён в словаре
      With xLayer
         If .CellsC(visLayerLock) Then oDict.Item(.Name) = .Index: .CellsC(visLayerLock) = 0
      End With
   Next xLayer
   Set oPage = ActivePage
   ' ====== копирование рисунков =========
   ActiveWindow.SelectAll
   ActiveWindow.Selection.Copy (1)
   ActiveWindow.DeselectAll
   For Each xLayer In ActiveWindow.Page.Layers      ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Name) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer
   ' ====== новая страница в текущем документе =========
   Set oNewPage = ActiveDocument.Pages.Add
   Call Duplicate_Page_CellsSRC(oPage, oNewPage)   ' копировать установки текушей страницы в новую
   oNewPage.Paste (1)
   For Each xLayer In ActiveWindow.Page.Layers   ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Name) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer
   ActiveWindow.Page = oPage
   Set oPage = Nothing
   Set oNewPage = Nothing
   Set oDict = Nothing
End Sub
Duplucate_Here_To
Спойлер: показать
Код:
Sub Duplucate_Here_To()
   Dim arrPage(7) As String
   Dim oPage As Visio.Page, oNewPage As Visio.Page
   Dim oActiveDoc As Visio.Document, oOtherDoc As Visio.Document, oDoc As Visio.Document
   Dim oActiveWindow As Visio.Window
   Dim xLayer As Visio.Layer
   Dim oDict As Object
   Set oDict = CreateObject("Scripting.Dictionary")
   For Each xLayer In ActiveWindow.Page.Layers   ' UnLock слоёв с запоминанием их индексов и имён в словаре
      With xLayer
         If .CellsC(visLayerLock) Then oDict.Item(.Name) = .Index: .CellsC(visLayerLock) = 0
      End With
   Next xLayer
   Set oActiveDoc = ActiveDocument
   Set oActiveWindow = ActiveWindow
   Set oPage = ActivePage
   ' ====== копирование рисунков =========
   ActiveWindow.SelectAll
   ActiveWindow.Selection.Copy (1)
   ActiveWindow.DeselectAll
   For Each xLayer In ActiveWindow.Page.Layers      ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Name) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer
   ' ==== назначение документа, куда копировать =====
   ' необходимо доработать - добавить выбор документа
   For Each oDoc In Application.Documents
      If oDoc.Name <> oActiveDoc.Name Then
         'If Not LCase(oDoc.Name) Like "*.vss*" Then
         If oDoc.Type = 1 Then   '1 == visTypeDrawing
            Set oOtherDoc = oDoc
            Exit For
         End If
      End If
   Next
   ' ====== новая страница в новом документе =========
   Set oNewPage = oOtherDoc.Pages.Add
   Call Duplicate_Page_CellsSRC(oPage, oNewPage)   ' копировать установки текушей страницы в новую
   oNewPage.Paste (1)
   For Each xLayer In ActiveWindow.Page.Layers      ' Lock слоёв, запомненных в словаре
      With xLayer
         If oDict.Exists(.Name) Then .CellsC(visLayerLock) = 1
      End With
   Next xLayer

   oActiveWindow.Activate
   Set oActiveWindow = Nothing
   Set oActiveDoc = Nothing
   Set oPage = Nothing
   Set oOtherDoc = Nothing
   Set oNewPage = Nothing
   Set oDict = Nothing
End Sub
Duplicate_Page_CellsSRC
Спойлер: показать
Код:
Private Sub Duplicate_Page_CellsSRC(oPageFrom As Visio.Page, oPageTo As Visio.Page)
   Dim arSection(): arSection = Array(visSectionObject)
   Dim arRow(): arRow = Array(visRowPage, visRowPrintProperties, visRowPageLayout)
   Dim iSection, iRow, iColumn
   For Each iSection In arSection
      For Each iRow In arRow
         For iColumn = 0 To 255
            On Error Resume Next
            oPageTo.PageSheet.CellsSRC(iSection, iRow, iColumn) = oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
            'Debug.Print oPageFrom.Name & "CellsSRC(" & iSection & "," & iRow & "," & iColumn & ").FormulaU = " & oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
         Next iColumn
      Next iRow
   Next iSection
End Sub
Ну а возможность выбора книги, куда копировать, выложу позже.
Сначала поэкспериментирую в в любимом и привычном Excel, а потом уже переложу на Visio/
Боюсь, правда, что без использования юзер-формы и модулей класса не обойтись. А это - отдельные модули проекта, что затрудняет его копирование, т.к. приходится делать жёсткую привязку к их именам. Да и с модулями класса я очень слаб, к сожалению :oops:

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Последний раз редактировалось Alex_ST 16 ноя 2016, 14:36, всего редактировалось 1 раз.

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

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Ну в принципе-то моя процедура хоть и привязана к объектам, но принцип сканирования по трём массивам параметров применим практически везде.
Я, к стати, специально именно поэтому не стал сканировать только по одному нужному мне значению секции, а задал её как массив из одного элемента:
Код:
Dim arSection(): arSection = Array(visSectionObject)

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


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

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
А вот Shape Data, User Defined Cells, Scratch, Actions, Hyperlinks и Layers - это отдельная песня.
С Shape Data, User Defined Cells, Scratch, Actions, Hyperlinks я ещё пока не сталкивался (просто не было необходимости), а вот с Layers никаких затруднений не возникло при сканировании для копирования листов. При этом там я процедуру запоминания в словаре упростил до запоминания только значений .CellsC(visLayerLock) , но ничего не мешало пробежаться по всем значениям каждого слоя и запоминать массивы.

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 14:08 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Проверил. Не копируются не видимые слои.
В принципе, собственно копирование секции слоев не нужно. Бросание на страницу шейпов принадлежащих какому то слою и так создает эти слои.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 14:14 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 14:35 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
Проверил. Не копируются не видимые слои.
Ну так я для невидимых и не делал. Делал только для залоченных. А про то, что невидимые тоже не выбираются при ActiveWindow.SelectAll я, естественно, забыл... :oops:
Ща поправлю.
К стати, Duplucate_Here_To у меня почему-то работает, но не лочит слои в получателе… Буду проверять.
Да и я там ещё забыл процедуры GetPageSettings и SetPageSettings заменить на Duplicate_Page_CellsSRC. Правлю прямо там.

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 15:46 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Alex_ST писал(а):
Duplucate_Here_To у меня почему-то работает, но не лочит слои в получателе…

Нашёл, где собака порылась.
Оказывается, после выполнения команды
Код:
Set oNewPage = ActiveDocument.Pages.Add
окно, содержащее oNewPage , активизируется и потому к нему можно обращаться как к ActiveWindow.Page (что в общем-то вполне логично).
Но после выполнения команды
Код:
Set oNewPage = oOtherDoc.Pages.Add
не только не автивизируется окно, содержащее oNewPage , но не активизируется даже и сам oOtherDoc
Поэтому к нему нельзя обращаться как к ActiveWindow.
Обновлённые процедуры здесь под спойлером
Спойлер: показать
Код:
Sub Duplucate_Here()
   Dim oPage As Visio.Page: Set oPage = ActivePage
   Dim oNewPage As Visio.Page
   Dim xLayer As Visio.Layer
   Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")
   For Each xLayer In oPage.Layers   ' UnLock слоёв с запоминанием их индексов и имён в словаре
      If xLayer.CellsC(visLayerLock) = 1 Then oDict.Item(xLayer.Name) = xLayer.Index: xLayer.CellsC(visLayerLock) = 0
   Next xLayer
   ' ====== копирование рисунков =========
   With ActiveWindow: .SelectAll: .Selection.Copy (1): .DeselectAll: End With
   For Each xLayer In oPage.Layers      ' Lock слоёв, запомненных в словаре
      If oDict.Exists(xLayer.Name) Then xLayer.CellsC(visLayerLock) = 1
   Next xLayer
   ' ====== новая страница в текущем документе =========
   Set oNewPage = ActiveDocument.Pages.Add
   Call Duplicate_Page_CellsSRC(oPage, oNewPage)   ' копировать установки текушей страницы в новую
   oNewPage.Paste (1)
   For Each xLayer In oNewPage.Layers   ' Lock слоёв, запомненных в словаре
      If oDict.Exists(xLayer.Name) Then xLayer.CellsC(visLayerLock) = 1
   Next xLayer
   ActiveWindow.Page = oPage
   Set oPage = Nothing
   Set oNewPage = Nothing
   Set oDict = Nothing
End Sub

Sub Duplucate_Here_To()
   Dim oActiveWindow As Visio.Window: Set oActiveWindow = ActiveWindow
   Dim oActiveDoc As Visio.Document: Set oActiveDoc = ActiveDocument
   Dim oPage As Visio.Page: Set oPage = ActivePage
   Dim oOtherDoc As Visio.Document
   Dim oNewPage As Visio.Page
   Dim xDoc As Visio.Document
   Dim xLayer As Visio.Layer
   Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")
   For Each xLayer In oPage.Layers   ' UnLock слоёв с запоминанием их индексов и имён в словаре
      If xLayer.CellsC(visLayerLock) = 1 Then oDict.Item(xLayer.Name) = xLayer.Index: xLayer.CellsC(visLayerLock) = 0
   Next xLayer
   ' ====== копирование рисунков =========
   With ActiveWindow: .SelectAll: .Selection.Copy (1): .DeselectAll: End With
   For Each xLayer In oPage.Layers      ' Lock слоёв, запомненных в словаре
      If oDict.Exists(xLayer.Name) Then xLayer.CellsC(visLayerLock) = 1
   Next xLayer
   ' ==== назначение документа, куда копировать =====
   ' необходимо доработать - добавить выбор документа
   For Each xDoc In Application.Documents
      If xDoc.Name <> oActiveDoc.Name Then
         'If Not LCase(xDoc.Name) Like "*.vss*" Then
         If xDoc.Type = visTypeDrawing Then
            Set oOtherDoc = xDoc: Exit For
         End If
      End If
   Next
   ' ====== новая страница в новом документе =========
   Set oNewPage = oOtherDoc.Pages.Add
   Call Duplicate_Page_CellsSRC(oPage, oNewPage)   ' копировать установки текушей страницы в новую
   oNewPage.Paste (1)
   For Each xLayer In oNewPage.Layers      ' Lock слоёв, запомненных в словаре
      If oDict.Exists(xLayer.Name) Then xLayer.CellsC(visLayerLock) = 1
   Next xLayer
   oActiveWindow.Activate
   Set oActiveWindow = Nothing
   Set oActiveDoc = Nothing
   Set oPage = Nothing
   Set oOtherDoc = Nothing
   Set oNewPage = Nothing
   Set oDict = Nothing
End Sub

Private Sub Duplicate_Page_CellsSRC(oPageFrom As Visio.Page, oPageTo As Visio.Page)
   Dim arSection(): arSection = Array(visSectionObject)
   Dim arRow(): arRow = Array(visRowPage, visRowPrintProperties, visRowPageLayout)
   Dim iSection, iRow, iColumn
   For Each iSection In arSection
      For Each iRow In arRow
         For iColumn = 0 To 255
            On Error Resume Next
            oPageTo.PageSheet.CellsSRC(iSection, iRow, iColumn) = oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
            'Debug.Print oPageFrom.Name & "CellsSRC(" & iSection & "," & iRow & "," & iColumn & ").FormulaU = " & oPageFrom.PageSheet.CellsSRC(iSection, iRow, iColumn)
         Next iColumn
      Next iRow
   Next iSection
End Sub
Исправить-то исправил, но по ходу дела возник вопрос: если известен лист oNewPage (As Visio.Page естественно), то какой командой можно активировать его окно?

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 16:10 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Цитата:
если известен лист oNewPage (As Visio.Page естественно), то какой командой можно активировать его окно?

Если oNewPage находится в активном сейчас документе:
Код:
ActiveWindow.Page = oNewPage

А если не в активном, то сначала активируем окно этого документа:
Код:
Windows.ItemEx("заголовок окна этого документа").Activate

или:
Код:
Windows.Item("индекс окна в коллекции Windows").Activate


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 16:34 
Не в сети
Постоянный участник
Аватара пользователя

Зарегистрирован: 14 сен 2012, 14:16
Сообщений: 83
Откуда: Москва
Использую Visio c: 2003
Отрасль: Телекоммуникации
Должность: Руководитель проектов ЦОД
Уровнь квалификации: VBA Excel Word
Очков репутации: 5

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
"заголовок окна этого документа"

Это ведь не oNewPage.Name ?
Это по крайней мере oOtherDoc.Name
Ну так как выглядит команда активации окна документа, содержащего oNewPage ?

_________________
С уважением, Алексей
(ИМХО: Excel-2003 - THE BEST!!!)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Копирование листа
СообщениеДобавлено: 16 ноя 2016, 16:51 
Не в сети
Ветеран

Зарегистрирован: 30 июл 2014, 14:28
Сообщений: 357
Использую Visio c: 2008
Очков репутации: 72

Добавить очки репутацииУменьшить очки репутации
Windows.ItemEx(oOtherDoc.Name).Activate


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 66 ]  На страницу Пред.  1, 2, 3, 4  След.

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



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

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


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

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