| Author |
 Topic  |
|
|
GDK
Russia
90 Posts |
 Posted - 11/09/2007 : 13:18:23
|
Чё то кажется что он писал про коннекторы из шаблона а не про обычный коннектор. Если это так то дергать за середину такого коннектора при нажатой кнопке Shift скорее всего бестоляк.
|
|
|
GDK
Russia
90 Posts |
Posted - 11/09/2007 : 13:27:33
|
| Извиняюсь за это сообщение. Я хотел этим сообщением ответьть на тему "произвольный коннектор". Но т.к. англ. яз. не понимаю - накосячил. Если можно перенесите это по адресу. |
 |
|
|
GDK
Russia
90 Posts |
Posted - 11/09/2007 : 13:36:06
|
На этом сайте нашёл макрос, который перебирает все фигуры на листе.
Но он не может перебирать те фигуры, которые находятся внутри группы. Для этого сделал другой макрос. Если это кому то надо, могу передать.
Может быть кто нибудь это сделал лучше? Тогда сообщите чтобы люди не пользовались косячными вещами. |
|
|
|
Tumanov
Russia
1198 Posts |
Posted - 11/09/2007 : 15:45:49
|
| Если макрос не очень большой, то можно просто скопировать сюда его текст. |
|
|
|
GDK
Russia
90 Posts |
Posted - 11/21/2007 : 07:52:48
|
Можно конечно. Только вот макрос состоит из нескольких процедур. Кстати почему то при копировании из редактора VBA на страницу текстового документа или ещё куда русские буквы заменяются всякой фигнёй и при этом комментарии не читаются.  Стоит ли засорять таким кодом место в этой теме. |
|
|
|
Tumanov
Russia
1198 Posts |
Posted - 11/21/2007 : 15:40:47
|
А надо русскую раскладку включить и в VBA и в приемнике - тогда скорее всего скопируется правильно.
Если здесь публиковать неудобно, то можно прислать мне на ttt@post.rzn.ru , а я его на сайт выложу. |
|
|
|
GDK
Russia
90 Posts |
Posted - 11/22/2007 : 11:34:23
|
quote:
Originally posted by Tumanov
А надо русскую раскладку включить и в VBA и в приемнике - тогда скорее всего скопируется правильно.
Получилось!
Dim ImenaGlob() As String
Dim Imena1() As String
Dim Imena2() As String
Dim CountGlob As Long
Dim Count1 As Long
Dim Count2 As Long
Dim stopImGl As Long
Sub переч() 'Эту надо запустить чтобы был результат.
Dim i(1 To 9) As Long 'Вместо 9-ти переменных для цыклов
Count1 = Application.ActiveDocument.Pages("тестовая").Shapes.Count 'Обратите внимание на эту строчку
If Count1 > 0 Then
ReDim Imena1(1 To Count1, 1 To 2) ' Забиваем в массив1 имена всех фигур на странице(не входящих в состав групп)
For i(1) = 1 To Count1
Imena1(i(1), 1) = Application.ActiveDocument.Pages("тестовая").Shapes(i(1)).NameID
Next i(1)
ReDim ImenaGlob(1 To Count1)
For i(2) = 1 To Count1 'Добавляем в массив имён данные из массива1
ImenaGlob(i(2)) = Imena1(i(2), 1)
Next i(2)
stopImGl = UBound(ImenaGlob) 'Определяем номер конечной записи массива имён фигур
Count2 = 1
Do While Count2 > 0
Count2Sub 'Подпрограмма
If Count2 > 0 Then
zapisIm2 'Подпрограмма
zapisIm1 'Подпрограмма
zapisImG 'Подпрограмма
End If
Loop
MSG 'Подпрограмма
Else: MsgBox ("Нет фигур на странице.")
End If
End Sub
Sub Count2Sub()
Dim i1 As Long
Count2 = 0
For i1 = 1 To UBound(Imena1, 1) 'Подсчитываем сумму фигур содержащихся во всех группах, имена которых содержатся в массиве1
Count2 = Count2 + _
Application.ActiveDocument.Pages("тестовая").Shapes(Imena1(i1, 1)).Shapes.Count
Next i1
End Sub
Sub zapisIm2()
Dim msg1 As Long
Dim message1 As String
Dim i1 As Long
Dim i2 As Long
Dim j2 As Long
i1 = 1
i2 = 1
j2 = 0
ReDim Imena2(1 To Count2, 2)
For i1 = 1 To UBound(Imena1, 1) 'Перебираем все фигуры которые в массиве1
For i2 = 1 To Application.ActiveDocument.Pages("тестовая") _
.Shapes(Imena1(i1, 1)).Shapes.Count 'для каждой фигуры _
массива1 определяем является ли она группой и если является то начинаем цыкл, _
который добавляет в массив2 имена фигур, входящих в состав этой фигуры (группы).
j2 = j2 + 1 'Получаем значение максимального индекса массива2. Это делается _
для того чтобы как бы подсчитать количество добавленных в массив2 записей _
и получить номер добавляемой записи. i1 & i2 не подходят для вычисления _
номера вновь добавляемой записи.
Imena2(j2, 1) = Application.ActiveDocument.Pages("тестовая") _
.Shapes(Imena1(i1, 1)).Shapes(i2).NameID
Next i2
Next i1
'For msg1 = 1 To UBound(Imena2, 1)
'message1 = message1 & Imena2(msg1, 1) & Chr(13)
'Next msg1
'MsgBox (message1) Можно раскомментировать (делалось чисто для проверки)
End Sub
Sub zapisIm1() 'В массив1 записываем данные из массива2 так, чтобы в массиве1 не _
сохранились старые данные. Кстати эту процедуру можно сократить. Когда был более _
носатым чайником чем счаз, лёгких путей не искал......
Dim i1 As Long
ReDim Imena1(1 To UBound(Imena2, 1), 1 To UBound(Imena2, 2))
For i1 = 1 To UBound(Imena2, 1)
Imena1(i1, 1) = Imena2(i1, 1)
Imena1(i1, 2) = Imena2(i1, 2)
Next i1
'For msg1 = 1 To UBound(Imena1, 1)
'message1 = message1 & Imena1(msg1, 1) & Chr(13)
'Next msg1
'MsgBox ("massiv1" & Chr(13) & message1) Можно раскомментировать (делалось чисто для проверки)
End Sub
Sub zapisImG()
ReDim Preserve ImenaGlob(1 To UBound(ImenaGlob) + UBound(Imena1, 1)) 'Переопределяем _
массив имён фигур с ключевым словом "PRESERVE" чтобы данные, хранящиеся в нём сохранились. _
Причём максимальный индекс высчитывается так чтобы добавить данные, хранящиеся в _
массиве1 и после этого не осталось пустых элементов в массиве имён фигур. Для этого _
складываем число записей массива имён фигур и число записей массива1.
For i1 = 1 To UBound(Imena1, 1) ' Добавляем записи из массива1 к массиву имён фигур
stopImGl = stopImGl + 1 'Индекс массива имён фигур, на котором закончили запись ранее + 1
ImenaGlob(stopImGl) = Imena1(i1, 1)
Next i1
End Sub
Sub MSG() 'Выводим в окно сообщений массив имён фигур. Эту Sub можно упростить (чайник!......).
For msg1 = 1 To UBound(ImenaGlob)
message1 = message1 & ImenaGlob(msg1) & Chr(13)
Next msg1
MsgBox (message1)
End Sub
|
|
|
| |
Topic |
|
|
|
All Forums
GDK