Author |
Topic |
|
brace
Russia
358 Posts |
Posted - 04/05/2005 : 17:17:24
|
Кто нить укажите где ошибка в коде ??? Макрос нужный но не выполняется. Заранее признателен.
Public Sub LocationTable() 'This routine will create a text file of the location and size of all 2-d shapes ' on the current page Dim shpObj As Visio.Shape, celObj As Visio.Cell Dim ShpNo As Integer, Tabchr As String, localCent As Double Dim LocationX As String, LocationY As String, ShapeWidth As String, ShapeHeight As String
Open "C:\LocationTable.txt" For Output Shared As #1
Tabchr = Chr(9)
For ShpNo = 1 To Visio.ActivePage.Shapes.Count
Set shpObj = Visio.ActivePage.Shapes(ShpNo) If Not shpObj.OneD Then ' Only list the 2-D shapes Set celObj = shpObj.Cells("pinx") localCent = celObj.Result("inches") LocationX = Format(localCent, "000.0000") Set celObj = shpObj.Cells("piny") localCent = celObj.Result("inches") LocationY = Format(localCent, "000.0000")
Set celObj = shpObj.Cells("width") localCent = celObj.Result("inches") ShapeWidth = Format(localCent, "000.0000") Set celObj = shpObj.Cells("height") localCent = celObj.Result("inches") ShapeHeight = Format(localCent, "000.0000")
Debug.Print shpObj.Name, CleanText(shpObj.Text), LocationX, LocationY, ShapeWidth, ShapeHeight Print #1, shpObj.Name; Tabchr; CleanText(shpObj.Text); Tabchr; LocationX; Tabchr; LocationY; Tabchr; ShapeWidth; Tabchr; ShapeHeight End If
Next ShpNo Close #1
End Sub
|
|
immortal
Russia
391 Posts |
Posted - 04/05/2005 : 17:22:56
|
а при запуске визио на какую строку показывает?
визио 2003 форэвер
...а вобще-то я белый и пушистый. |
|
|
immortal
Russia
391 Posts |
Posted - 04/05/2005 : 17:26:28
|
если он не выдаёт ошибки а просто не применяет значения ячейкам в шейплисте то хначит у значения нет кавычек или наоборот они есть, надо сделать проверку на наличие или отсутствие символа "
визио 2003 форэвер
...а вобще-то я белый и пушистый. |
|
|
brace
Russia
358 Posts |
Posted - 04/05/2005 : 17:46:16
|
ну чего мы в испорченный телефон играть будем ??? запустите и все сообщения увидите. автор кода программист на VBA. но неудобно американцу писать легче спросить у своих -:)
|
|
|
Tumanov
Russia
1198 Posts |
Posted - 04/05/2005 : 19:38:00
|
Все там работает. Только не хватает функции CleanText. Это Вы не все списали, надо где-нибудь рядом посмотреть. Функция должна какую-то несложную операцию с текстом шейпа выполнять. Чтобы заработало без нее, оставьте вместо функции только аргумент shpObj.Text и будет достаточно. Нужно подправить две строчки:
Debug.Print shpObj.Name, shpObj.Text, LocationX, LocationY, ShapeWidth, ShapeHeight Print #1, shpObj.Name; shpObj.Text; Tabchr; Tabchr; LocationX; Tabchr; LocationY; Tabchr; ShapeWidth; Tabchr; ShapeHeight
|
|
|
brace
Russia
358 Posts |
Posted - 04/06/2005 : 10:56:04
|
УРА !!! РАБОТАЕТ !!! СПАСИБО !!! но названия фигур в отчете (ТХТ файле) не те что видны на экране а как в Stencil(е) а мне нужны как на экране те надо два поля в отчет добавить Shape Number и ShapeNumber Text и еще надо бы не в дюймах а в мм отчет получать. это можно сделать ???
|
|
|
brace
Russia
358 Posts |
Posted - 04/06/2005 : 16:59:05
|
quote: Функция должна какую-то несложную операцию с текстом шейпа выполнять.
Поскольку макрос написан для экспорта данных в тхт файл нетрудно догадаться что функция должна выводить текст шейпа в файл. Замена функции аргументом привела к появлению знака "?" во второй колонке тхт файла для всех строк. Это можно как нить исправить ??? |
|
|
Tumanov
Russia
1198 Posts |
Posted - 04/06/2005 : 20:40:01
|
1. Что за названия у Вас на экране я не знаю, поэтому подставить не могу. Но сделать это легко. Нужно только в Debug.Print и Print #1 добавить либо свойство по аналогии с shpObj.Name, либо значение ячейки шейп-листа по аналогии с Set celObj = shpObj.Cells("pinx") - только вместо PinX подставить имя нужной Вам ячейки.
2. Чтобы отчет получать в мм, нужно во всех .Result вместо дюймов подставить миллиметры Result("millimeters")
3. На самом деле нетрудно догадаться, что функция должна вычищать из текста какие-то спецсимволы. Выводится-то текст оператором Print #1. Какие спецсимволы находятся в Вашем тексте я не знаю. У меня текст печатается без всяких знаков вопросов. Если нужно что-то вычищать, то нужно писать примерно такую функцию
Public Function CleanText(ByVal str As String) As String CleanText = Replace(str, Chr(10), "") End Function
Эта функция, например, будет выбрасывать встречающиеся переводы строки. Естественно, что в основном макросе нужно вернуть обращение CleanText(shpObj.Text). А вообще-то, Вам нужно определяться со своей ролью. Если Вы программист, то надо потихонечку знакомиться с шейп-листом и объектами Visio. Макрос-то несложный. Если пользователь, которому нужно решить определенную задачу, то в данном случае дешевле и быстрее нанять программиста и сформулировать ему требования. А он ее за недельку спокойно сделает. |
|
|
brace
Russia
358 Posts |
Posted - 04/07/2005 : 09:11:32
|
1. я не программист а инженер связи. и пытаюсь слегка автоматизировать свою работу. у нас есть программисты но они заняты глобальными задачами. и загружены выше крыши. Нанимать программистов за свои кровные это наверное шутка. 2. здесь вроде как форум "Вопросы и Ответы." так что извините что побеспокоил.
|
|
|
immortal
Russia
391 Posts |
Posted - 04/07/2005 : 10:26:33
|
quote: Originally posted by brace
1. я не программист а инженер связи. и пытаюсь слегка автоматизировать свою работу. у нас есть программисты но они заняты глобальными задачами. и загружены выше крыши. Нанимать программистов за свои кровные это наверное шутка. 2. здесь вроде как форум "Вопросы и Ответы." так что извините что побеспокоил.
есть такой раздел на форуме, для заказчиков....
визио 2003 форэвер
...а вобще-то я белый и пушистый. |
|
|
Tumanov
Russia
1198 Posts |
Posted - 04/07/2005 : 19:14:57
|
Это Вы к тому, что помимо вопросов и ответов я еще и советы даю? Ну, извините, хотел как лучше. Ведь если считать деньги, то таким образом Вы слишком много времени (а значит и денег) угробите там, где можно было бы дешевле сделать. А на вопросы Вам отвечают. Если где-то не смогли, значит не хватило информации - пояснять надо. |
|
|
|
Topic |
|