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

Форум по вопросам применения и программирования в Visio
Текущее время: 29 мар 2024, 13:12

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


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


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

Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 23 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 25 мар 2016, 17:23 
Не в сети
Новичок

Зарегистрирован: 25 мар 2016, 17:19
Сообщений: 21
Использую Visio c: 2013
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Народ, может у кого-то уже есть такое. Нужен макрос, который бы клонировал объект, но менял текст, записанный в нём. Например, у нас выделен прямоугольник, в нём написано "123", нажимаем Ctrl+M - появляется такой же прямоугольник (того же размера, тем же слоем), но уже с надписью "124".

Surrogate писал(а):


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

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

Добавить очки репутацииУменьшить очки репутации
Посмотри вот это:
http://visio.getbb.ru/viewtopic.php?f=15&t=685

_________________
GitHub
Yandex-диск с набором полезных утилит


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 25 мар 2016, 19:01 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
koui, задам пару уточняющих вопросов:
1. в каком именно месте должна появиться клон прямоугольника
2. текст "124" постоянно, или должно быть приращение к значению выделенного прямоугольника

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


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

Зарегистрирован: 25 мар 2016, 17:19
Сообщений: 21
Использую Visio c: 2013
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Surrogate писал(а):
koui, задам пару уточняющих вопросов:
1. в каком именно месте должна появиться клон прямоугольника
2. текст "124" постоянно, или должно быть приращение к значению выделенного прямоугольника

1. это не важно, можно по центру экрана. это маркировка, она будет расставляться рядом с объектами.
2. текст должен приращаться, например "А1.124"


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 28 мар 2016, 12:57 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
по первой части
Код:
Sub koui()
Dim SH As Shape
Set SH = ActiveWindow.Selection.PrimaryItem
SH.Copy
ActivePage.Paste
End Sub
по второй нужна информация о том, какой формат входных данных и какой выходных. я запутался в этом:
koui писал(а):
у нас выделен прямоугольник, в нём написано "123", нажимаем Ctrl+M - появляется такой же прямоугольник (того же размера, тем же слоем), но уже с надписью "124".
koui писал(а):
2. текст должен приращаться, например "А1.124"

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


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

Зарегистрирован: 25 мар 2016, 17:19
Сообщений: 21
Использую Visio c: 2013
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Surrogate писал(а):
по первой части
Код:
Sub koui()
Dim SH As Shape
Set SH = ActiveWindow.Selection.PrimaryItem
SH.Copy
ActivePage.Paste
End Sub
по второй нужна информация о том, какой формат входных данных и какой выходных. я запутался в этом:
koui писал(а):
у нас выделен прямоугольник, в нём написано "123", нажимаем Ctrl+M - появляется такой же прямоугольник (того же размера, тем же слоем), но уже с надписью "124".
koui писал(а):
2. текст должен приращаться, например "А1.124"

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


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 29 мар 2016, 00:50 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
koui писал(а):
ох, я в визио новичок и видимо не понимаю вопроса
тяжелый случай ! я имел в виду как должен выглядеть текст фигуры префикс<разделитель>число. например A1.33
Евгени в сообщении #8684 писал(а):
испытаю свои сверх-возможности
чё может я тоже телепат 90lvl ?
Код:
Sub koui()
Dim SH As Shape, txt As String
Set SH = ActiveWindow.Selection.PrimaryItem
If IsNumeric(Mid(SH.Text, InStr(SH.Text, ".") + 1, Len(SH.Text) - InStr(SH.Text, "."))) Then
txt = Left(SH.Text, InStr(SH.Text, ".")) & (Mid(SH.Text, InStr(SH.Text, ".") + 1, Len(SH.Text) - InStr(SH.Text, ".")) + 1)
SH.Copy
Set SH = Nothing
ActivePage.Paste
Set SH = ActiveWindow.Selection.PrimaryItem
SH.Text = txt
Else
MsgBox "Текст фигуры не соответствует формату A1.N"
Exit Sub
End If
End Sub

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


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

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

Добавить очки репутацииУменьшить очки репутации
Surrogate, попробовал твой код. Выдает:

Изображение

А вот если выполнять код пошагово (F8), то все нормально. Черт знает?!

В общем вот так нет проблем:

Код:
Sub koui()
Dim SH As Shape, txt As String
Set SH = ActiveWindow.Selection.PrimaryItem

If IsNumeric(Mid(SH.Text, InStr(SH.Text, ".") + 1, Len(SH.Text) - InStr(SH.Text, "."))) Then
        txt = Left(SH.Text, InStr(SH.Text, ".")) & (Mid(SH.Text, InStr(SH.Text, ".") + 1, Len(SH.Text) - InStr(SH.Text, ".")) + 1)
        SH.Duplicate
        Set SH = ActiveWindow.Selection.PrimaryItem
        SH.Text = txt
    Else
        MsgBox "Текст фигуры не соответствует формату A1.N"
        Exit Sub
End If

End Sub

_________________
GitHub
Yandex-диск с набором полезных утилит


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 29 мар 2016, 08:53 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
Shishok, фигасе ! я тоже гонял его только в пошаговом режиме
ЗЫ запустил сейчас в визио 2003 - работает
PPS зашел на рабочий комп с визио 2010 по VPN, там мой код тоже работает !

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


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

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

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

Код:
Sub koui()
Dim SH As Shape, txt As String
Const Separator = "."

Set SH = ActiveWindow.Selection.PrimaryItem

If IsNumeric(Mid(SH.Text, InStr(SH.Text, Separator) + 1, Len(SH.Text) - InStr(SH.Text, Separator))) Then
        txt = Left(SH.Text, InStr(SH.Text, Separator)) & (Mid(SH.Text, InStr(SH.Text, ".") + 1, Len(SH.Text) - InStr(SH.Text, Separator)) + 1)
        SH.Duplicate
        ActiveWindow.Selection.PrimaryItem.Text = txt
    Else
        MsgBox "Текст фигуры не соответствует формату A1.N"
        Exit Sub
End If

End Sub
А если TS вставит в свои шейпы RunMAcro...Koui в ячейку EventDrop то и совсем хорошо. Может использовать Ctrl+D для работы.

_________________
GitHub
Yandex-диск с набором полезных утилит


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 29 мар 2016, 09:05 
Не в сети
Content manager
Content manager
Аватара пользователя

Зарегистрирован: 02 окт 2009, 01:01
Сообщений: 5043
Откуда: оттуда
Использую Visio c: 1998
Отрасль: Интеграция системных интеграторов
Должность: Дизайнер по оформлению документации
Уровнь квалификации: Форматирование документов MS Word
Shishok, наш топик-стартер писал
koui писал(а):
в принципе, меня устроит любой формат, лишь бы он был видимым.
с этой точки зрения наши коды удовлетворяют этому условию чуть более, чем полностью !
Surrogate писал(а):
чё может я тоже телепат 90lvl ?
вопрос только угадили ли мы с форматом текста в шейпе ?
код будет работать даже в случае если, текст шейпа просто число.
в твоем последнем варианте будет достаточно заменить константу разделителя

_________________
База знаний ShapeSheet
Мой Youtube-канал @surrogate-tm
Мои трафареты


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

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

Добавить очки репутацииУменьшить очки репутации
Цитата:
вопрос только угадили ли мы с форматом текста в шейпе ?


Это к ТС. А насчет RunMacro в EventDrop, не прокатило. Из за SH.Duplicate. Код зацикливается, создается 100500 шейпов и до бесконечности. :twisted:

_________________
GitHub
Yandex-диск с набором полезных утилит


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Макрос на копирование объекта с изменением текста
СообщениеДобавлено: 29 мар 2016, 09:49 
Не в сети
Ветеран

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

Добавить очки репутацииУменьшить очки репутации
Ну и еще вариант на скорую руку:

Код:
Sub AutoNum()
Dim SH As Shape, num As String, i As Integer
' В конце текста шейпа должны быть цифры. Они будут увеличиваться на 1.
' Все что слева от цифр не имеет значения.
' Если в тексте только цифры, то же работает.

Set SH = ActiveWindow.Selection.PrimaryItem

If Not IsNumeric(Right(SH.Text, 1)) Then Exit Sub

For i = Len(SH.Text) To 1 Step -1
    If IsNumeric(Mid(SH.Text, i, 1)) Then
        num = Mid(SH.Text, i, 1) & num
      Else
        Exit For
    End If
Next

SH.Duplicate
ActiveWindow.Selection.PrimaryItem.Text = Left(SH.Text, i) & Val(num) + 1

End Sub

_________________
GitHub
Yandex-диск с набором полезных утилит


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

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

Добавить очки репутацииУменьшить очки репутации
А вот макрос для работы с помощью Ctrl+...
Код:
' Module1
Option Explicit

Sub AutoNum() ' Только для работы с Ctrl + D и Ctrl + Move + F4,
' а также Ctrl + C and Ctrl + V (это работает только 1 раз)

' Шейп должен иметь в секции Events, в ячейке EventDrop формулу "=RUNMACRO("Module1.AutoNum","www")"
' Module1 - имя модуля, где находится макрос
' www - имя активного файла .vsd или .vss (в нем и должен находиться сей модуль с макросом)

' В конце текста шейпа должны быть цифры. Они будут увеличиваться на 1.
' Все что слева от цифр не имеет значения.
' Если в тексте только цифры, тоже работает.

Dim SH As Shape, num As String, i As Integer

Set SH = ActiveWindow.Selection.PrimaryItem

If Not IsNumeric(Right(SH.Text, 1)) Then Exit Sub

For i = Len(SH.Text) To 1 Step -1
    If IsNumeric(Mid(SH.Text, i, 1)) Then
        num = Mid(SH.Text, i, 1) & num
      Else
        Exit For
    End If
Next

ActiveWindow.Selection.PrimaryItem.Text = Left(SH.Text, i) & Val(num) + 1

End Sub

Изображение

_________________
GitHub
Yandex-диск с набором полезных утилит


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

Зарегистрирован: 25 мар 2016, 17:19
Сообщений: 21
Использую Visio c: 2013
Очков репутации: 0

Добавить очки репутацииУменьшить очки репутации
Shishok писал(а):
Ну и еще вариант на скорую руку:
спасибо огромное, то, что надо! да еще если отключить SH.Duplicate то он просто увеличивает текст на 1, что так же бывает мне полезно )


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

Зарегистрирован: 12 май 2012, 15:16
Сообщений: 122
Очков репутации: 13

Добавить очки репутацииУменьшить очки репутации
Оффтоп:
Shishok писал(а):
создается 100500 шейпов
и все 100500 видимые ? тогда условие ТС выполнено


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

Зарегистрирован: 12 май 2012, 15:16
Сообщений: 122
Очков репутации: 13

Добавить очки репутацииУменьшить очки репутации
Shishok
у меня RUNMACRO не запустил макрос... можно Ваш исходник?


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

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

Добавить очки репутацииУменьшить очки репутации
Цитата:
и все 100500 видимые ? тогда условие ТС выполнено


Да это ошибка была. Да видимые, но это бесконечный цикл был. :( Только принудительная остановка - Ctrl+Break.
А исходник...
Вложение:
www.vsd [25 Кб]
Скачиваний: 162

_________________
GitHub
Yandex-диск с набором полезных утилит


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

Зарегистрирован: 12 май 2012, 15:16
Сообщений: 122
Очков репутации: 13

Добавить очки репутацииУменьшить очки репутации
Shishok
Эффекта 0. Не рунит в макро. Что я делаю не так? ©


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

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

Добавить очки репутацииУменьшить очки репутации
Даже не знаю. Проверил на другом компе в той же версии (Visio 2010). Работает!

_________________
GitHub
Yandex-диск с набором полезных утилит


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

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



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

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


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

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