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

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

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


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


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



Начать новую тему Ответить на тему  [ Сообщений: 77 ]  На страницу 1, 2, 3, 4  След.
Автор Сообщение
 Заголовок сообщения: Замена текста в нескольких файлах по таблице соответствия
СообщениеДобавлено: 24 сен 2016, 10:50 
Не в сети
Новичок

Зарегистрирован: 24 сен 2016, 10:28
Сообщений: 22
Использую Visio c: 2014
Уровнь квалификации: пока плохо
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Добрый день !

Буду очень благодарен за помощь в решении задачи:
1. Есть схемы в формате "визио" с указанием адресов (это текстовые поля) элементов схемы. (Схема1)
2. Есть таблица соответствия неправильного текста - правильному, колонки А и В соответственно.
Можно ли автоматизировать процесс поиска в нескольких схемах текста из колонки А и их замену на текст из колонки В ?
Дополнено позднее: Тема получила свое продолжение в ветках обсуждения:
Find&Replace Addon For MS Visio
Скорость обработки документов Visio из Excel


Вложения:
1.rar [32.61 Кб]
Скачиваний: 12
IP адреса.xlsx [8.79 Кб]
Скачиваний: 15


Последний раз редактировалось Surrogate 20 фев 2017, 00:31, всего редактировалось 1 раз.
добавлены ссылки на родственные ветки
Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Замена текста в нескольких файлах по таблице соответствия
СообщениеДобавлено: 24 сен 2016, 11:35 
Не в сети
Administrator

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

Добавить очки репутацииУменьшить очки репутации
Можно.
Но программку писать придется. Значит, получится не так уж быстро. Так что надо будет оценивать, что быстрее - вручную или программно.
В принципе, в одном документе можно провести поиск и замену по всем листам документа. И вроде бы даже с подстановками типа Any character. То есть в одном документе достаточно быстро получится.
---
А программно...
Считать табличку из Excel - не проблема.
Перебрать файлы в папке - тоже.
Дальше в объектной модели Visio: открыть файл, перебрать все страницы, перебрать все шейпы на странице - сравнивать текст с одной колонкой; если сравнился, менять на текст из другой колонки.
Программку можно реализовать, например, как макрос в том самом Excel.
Ну, это так, "в лоб".


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

Зарегистрирован: 24 сен 2016, 10:28
Сообщений: 22
Использую Visio c: 2014
Уровнь квалификации: пока плохо
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Таблица соответствия адресов - это несколько тысяч строк, схем- сотни.
Мрачная перспектива вручную это делать.
От чего оттолкнуьтся - не знаю, не специалист по VBA ... может кто примером поможет.


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

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

Добавить очки репутацииУменьшить очки репутации
Таких примеров скорее всего не будет. Задача не типовая.
Можно подобрать примерчики для каждого из приведенных шагов... Но это уже не быстро.
И если "не специалист в VBA", то боюсь, процесс серьезно затянется.
Мне кажется, что в данном случае проще было бы заказать кому-нибудь разработку макроса. А в дальнейшем (при последующих изменениях) использовать его уже как пример.
----
А может еще не поздно и сменить подход?
Такое впечатление, что в Ваших схемах нужно было использовать связь с данными. Тогда при изменении данных достаточно было бы просто нажать кнопку "Обновить".


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

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

Добавить очки репутацииУменьшить очки репутации
Вот немного похожая задача. В одном документе разыскивались и подкрашивались фрагменты текста по определенному образцу.
Код:
Private regEx As VBScript_RegExp_55.RegExp
Private Match As VBScript_RegExp_55.Match
Private Matches
Private ArRes()

'Main procedure scans all pages, shapes and shapes in groups
Public Sub ColorTags()
    Dim d As Visio.Document
    Dim p As Visio.Page
    Set d = ActiveDocument
    For i = 1 To d.Pages.Count              'Each page
        Set p = d.Pages(i)
        For j = 1 To p.Shapes.Count         'Each shape
            Dim Shp As Visio.Shape
            Set Shp = p.Shapes(j)
            If Shp.Type = visTypeGroup Then 'If shape is the group, then it scans contained shapes
                For k = 1 To Shp.Shapes.Count
                    Dim shp2 As Visio.Shape
                    Set shp2 = Shp.Shapes(k)
                    ColorOneShape shp2      ' => color it
                Next
            ElseIf Shp.Type = visTypeShape Then 'Shape is not group
                ColorOneShape Shp           ' => color it
            End If
        Next
    Next
End Sub

'Searh tags in one shape and colors it
Private Sub ColorOneShape(ByVal Shp As Visio.Shape)
    s = Shp.Text
    ar = GetTags(s)     'Get begin and end position for each tag
    If UBound(ar, 2) > 0 Then
        For m = 1 To UBound(ar, 2)
            Dim vChar As Visio.Characters
            Set vChar = Shp.Characters
            vChar.Begin = ar(1, m)  'Start position for current tag
            vChar.End = ar(2, m)    'End position for current tag
            vChar.CharProps(visCharacterColor) = 4  'Blue
        Next
    End If
End Sub

'Get array of start and end position for each tag in string
Private Function GetTags(ByVal s As String) As Variant
   ReDim ArRes(2, 0)
   Set regEx = New RegExp           ' Create regular expression.
   regEx.Global = True
   regEx.pattern = "<[^<^>]*>"        ' Set pattern "<Variable>"
   Set Matches = regEx.Execute(s)   ' Execute search.
   MatchesToArray   '=>
   regEx.pattern = "@[^ ]*\s"       ' Set pattern "@Variable "
   Set Matches = regEx.Execute(s)
   MatchesToArray   '=>
   Set regEx = Nothing
   GetTags = ArRes
End Function

'Convert Match attributes (first, length) to array (start, end)
Private Sub MatchesToArray()
   For Each Match In Matches        ' Iterate Matches collection.
      Bound = UBound(ArRes, 2) + 1
      ReDim Preserve ArRes(2, Bound)
      ArRes(1, Bound) = Match.FirstIndex
      ArRes(2, Bound) = Match.FirstIndex + Match.Length
   Next
End Sub


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

Зарегистрирован: 24 сен 2016, 10:28
Сообщений: 22
Использую Visio c: 2014
Уровнь квалификации: пока плохо
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
"Нам бы схемку, аль чертеж - мы б затеяли вертеж !"
Спасибо за ответ, но как "мелкому специалисту" нужны уточнения.
Этот код надо вставить с существующий файл "СХЕМА" и что дальше ?
Можно рассказать, что он делает ?
Его в визио надо вставить или в эксел ?
Буду разбираться как код работает.

А сколько может стоить решение задачи под ключ ?


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

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

Добавить очки репутацииУменьшить очки репутации
Этот код приведен только как пример. Была немного похожая задача. Я скопировал оттуда текст макроса.
Макрос работал в Visio по тому документу, в который он был вставлен.
Если вставлять в Excel, то обращение к документу изменится.
Вам интересна главная процедура Public Sub ColorTags(), в которой есть перебор шейпов в документе
For i = 1 To d.Pages.Count - перебирает страницы
For j = 1 To p.Shapes.Count - перебирает шейпы на странице
Может потребоваться работа с регулярными выражениями Private regEx As VBScript_RegExp_55.RegExp
Выборка текста из шейпа - s = Shp.Text
Замены текста здесь нет, в этой задаче изменялся не текст, а его атрибуты.
Вообще-то, смотрю сейчас, и вижу, что заимствовать можно будет не так уж много :( Одна процедура, да общий подход...)
---------
Насчет "под ключ" - я могу только высказать свои соображения, а у исполнителя могут быть другие оценки.
По моим прикидкам на первую работоспособную версию может уйти порядка двух часов работы. То есть в районе $30. Довольно часто после первой версии заказчику хочется еще что-то добавить, усовершенствовать. Понятно, что это можно делать до бесконечности...
Прикидка, естественно, грубая и субъективная. Так, в качестве ориентира.
Не исключено, что исполнитель может взять гораздо дешевле просто потому, что задача понравится и в надежде, что ее можно будет в дальнейшем тиражировать.


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

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3224
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
Я меньше чем за 7040р не берусь за работу.


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

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

Добавить очки репутацииУменьшить очки репутации
Ну или понемножку пошагово можно решать задачу прямо здесь. Глядишь на каждом шаге кто-нибудь да поможет...
Первым делом явно надо из Excel файла добраться до списка нужных файлов.
Для начала можно попробовать такой способ, как вот в этом примере.
Макрос лезет в папку, в которой сам находится и выбирает оттуда все файлы с расширением .vsd в коллекцию Filenames.
Потом выводит содержимое коллекции в окно Immediate.
Код:
Dim Filenames As Collection

Sub MainSub()
    Set Filenames = New Collection
    Set fs = CreateObject("Scripting.FileSystemObject")
    s1 = CurDir
    Set dd = fs.GetFolder(s1)
    Set fc = dd.Files
    Dim fcou As Integer
    fcou = fc.Count
    i = 0
    For Each ss In fc
        If Right(ss.Name, 4) = ".vsd" Then
            Filenames.Add ss.Name
            i = i + 1
        End If
    Next
    TestPrint
End Sub

Sub TestPrint()
    For i = 1 To Filenames.Count
        Debug.Print Filenames(i)
    Next
End Sub

Следующим шагом (когда ученик освоит этот) нужно будет учиться открывать и закрывать документы Visio по этому списку. И т.д.
Так сказать, совместим с процессом обучения. Глядишь, еще кому-то пригодится.


Вложения:
IP адреса.xlsm [15.04 Кб]
Скачиваний: 11
Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Замена текста в нескольких файлах по таблице соответствия
СообщениеДобавлено: 24 сен 2016, 17:16 
Не в сети
Administrator

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 3224
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Связь
Должность: Бывший проектировщик
Уровнь квалификации: ShapeSheet, VBA
Tumanov писал(а):
Так сказать, совместим с процессом обучения. Глядишь, еще кому-то пригодится.
если нет желания платить, мы можем бесплатно помучить!


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

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

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


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

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

Добавить очки репутацииУменьшить очки репутации
Цитата:
я бы разместил макрос в visio

Не очень хорошо, потому что файлы уже существуют и их очень много.
А Excel - один.


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

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

Добавить очки репутацииУменьшить очки репутации
Я, кстати, базовую весию дописал...
AlexDen все равно, похоже, учиться не хочет. Деньжищи уплыли :( Это его Surrogate напугал :)
Код:
Dim Filenames As Collection
Dim CurrFolder As String
Dim RenArr()

Sub MainSub()
    GetRenArray
    Set Filenames = New Collection
    Set fs = CreateObject("Scripting.FileSystemObject")
    CurrFolder = Application.ActiveWorkbook.Path & "\"
    Set dd = fs.GetFolder(CurrFolder)
    Set fc = dd.Files
    Dim fcou As Integer
    fcou = fc.Count
    i = 0
    For Each ss In fc
        If Right(ss.Name, 4) = ".vsd" Then
            Filenames.Add ss.Name
            i = i + 1
        End If
    Next
    TestPrint
End Sub

Private Sub TestPrint()
    For i = 1 To Filenames.Count
        ProcessDocument (CurrFolder & Filenames(i))
    Next
End Sub

Private Sub ProcessDocument(ByVal docPath As String)
    Dim vApp As Visio.InvisibleApp
    Dim doc As Visio.Document
    Set vApp = CreateObject("Visio.InvisibleApp")
    Set doc = vApp.Documents.Open(docPath)
        Debug.Print "Имя документа = " & doc.Name
        Debug.Print "Количество листов = " & doc.Pages.Count
   
        Dim p As Visio.Page
        For i = 1 To doc.Pages.Count            'Each page
            Set p = doc.Pages(i)
            For j = 1 To p.Shapes.Count         'Each shape
                Dim Shp As Visio.Shape
                Set Shp = p.Shapes(j)
                Debug.Print Shp.Text
                ReplaceText Shp
            Next
        Next
   
    doc.Save
    doc.Close
    vApp.Quit
    Set doc = Nothing
    Set vApp = Nothing
End Sub

Private Sub ReplaceText(ByVal Shp As Visio.Shape)
    s = Shp.Text
    For i = 1 To UBound(RenArr, 2)
        If StrComp(s, RenArr(1, i)) = 0 Then
            Shp.Text = RenArr(2, i)
            Exit For
        End If
    Next
End Sub

Private Sub GetRenArray()
    Dim r As Range
    Set r = Range("A1")
    Set reg = r.CurrentRegion
    Debug.Print reg.Rows.Count
    Debug.Print reg.Columns.Count
    rs = reg.Rows.Count
    cs = reg.Columns.Count
    ReDim RenArr(2, 12)
    For i = 1 To rs
        RenArr(1, i) = r.Offset(i - 1, 0)
        RenArr(2, i) = r.Offset(i - 1, 1)
    Next
    For i = 1 To UBound(RenArr, 2)
        Debug.Print RenArr(1, i), RenArr(2, i)
    Next
End Sub


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

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

Добавить очки репутацииУменьшить очки репутации
Моя версия:
Код:
Option Explicit

Dim Filenames As Collection
Dim arrRange
Const Path = "Диск:\папка\папка\папка"

Sub MainSub()
Dim fs As Object, dd As Object, fc As Object, ss As Object
Dim i As Integer

arrRange = ActiveSheet.UsedRange
Set Filenames = New Collection
Set fs = CreateObject("Scripting.FileSystemObject")
Set dd = fs.GetFolder(Path)
Set fc = dd.Files

For Each ss In fc
    If Right(ss.Name, 4) = ".vsd" Then
        Filenames.Add ss.Name
    End If
Next

For i = 1 To Filenames.Count
    OpenVisioFile (Path & "\" & Filenames(i))
Next
   
End Sub

Sub OpenVisioFile(PathName)
Dim oVisio As Object, oDoc As Object, oShapes As Object, oSh As Object
Dim i As Integer

Set oVisio = CreateObject("Visio.Application")
Set oDoc = oVisio.Documents.OpenEx(PathName, &H40)

Set oShapes = oDoc.Pages.Item(1).Shapes

For Each oSh In oShapes
    For i = 1 To UBound(arrRange, 1)
        If oSh.Characters.Text Like "*" & arrRange(i, 1) & "*" Then oSh.Characters.Text = Replace(oSh.Characters.Text, arrRange(i, 1), arrRange(i, 2), 1)
    Next
Next

oDoc.Save
oDoc.Close
oVisio.Quit
End Sub


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

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

Добавить очки репутацииУменьшить очки репутации
Мимо UsedRange я как-то проскочил.


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

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

Добавить очки репутацииУменьшить очки репутации
Косяк у меня в коде. Адрес 10.255.0.10 становится 10.221.0.110. А должен быть - 10.221.0.20. Оператор Like, в нем дело.


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

Зарегистрирован: 24 сен 2016, 10:28
Сообщений: 22
Использую Visio c: 2014
Уровнь квалификации: пока плохо
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Хочет учиться AlexDen !

Положил файлы в с:\testFOLDERtest ( "Схема1" , "Схема2" и "IP адрес.xlsm")

Const Path = "C:\testFOLDERtest\" в скрипт я вставил, но не понял что происходит


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

Зарегистрирован: 24 сен 2016, 10:28
Сообщений: 22
Использую Visio c: 2014
Уровнь квалификации: пока плохо
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
Косяк у меня в коде. Адрес 10.255.0.10 становится 10.221.0.110. А должен быть - 10.221.0.20. Оператор Like, в нем дело.


Почему-то не могу даже с ошибкой повторить ...


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

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

Добавить очки репутацииУменьшить очки репутации
Цитата:
Const Path = "C:\testFOLDERtest\" в скрипт я вставил, но не понял что происходит

Последний слеш убери! То есть вот так - Const Path = "C:\testFOLDERtest"


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

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

Добавить очки репутацииУменьшить очки репутации
AlexDen у тебя там адреса всегда на 10.xxxxxxx начинаются?


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

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



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

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


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

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