Для русскоязычных пользователей Visio. Начинающих и профессионалов. Где взять, как сделать, что купить и т.д.

Документы

Перечень литературы

07.01.2015  Cleaning Visio Documents  David Parker.   

Ответы на вопросы

Создание документа Excel из Visio

Создание документа Excel из Visio 

Sub ttt()

' Dim xlApp As Excel.Application
Dim xlApp As Object

Const XL_NOTRUNNING As Long = 429

On Error GoTo ShowName_Err
Err.Clear

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

' Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then MsgBox "xlApp"
' xlApp.Visible = True
MsgBox xlApp.Worksheets.Count
If xlApp.ActiveSheet Is Nothing Then MsgBox "xlApp.ActiveSheet"
MsgBox "'" & xlApp.ActiveSheet.Name & "' is the currently active worksheet."

Range("A2").Select
ActiveCell.FormulaR1C1 = "1222777777777777777"
Range("B2").Select
ActiveCell.FormulaR1C1 = "22"
Range("C2").Select
ActiveCell.FormulaR1C1 = "34"
Range("A3").Select
' xlApp.ActiveWorkbook.SaveAs Filename:= _
' "C:\Documents and Settings\tumanov.CIT\Мои документы\Книга1.xls", FileFormat _
' :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
' False, CreateBackup:=False
' xlApp.Workbooks(1).Activate
' fName = xlApp.GetSaveAsFilename
fName = "C:\Documents and Settings\tumanov.CIT\Мои документы\Книга1.xls"

MsgBox xlApp.ActiveWorkbook.FullName

xlApp.DisplayAlerts = False
xlApp.ActiveWorkbook.SaveAs Filename:=fName
xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

ShowName_End:
Exit Sub
ShowName_Err:
If Err = XL_NOTRUNNING Then
' Excel is not currently running.
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

MsgBox "Version = " & xlApp.Version

Resume Next
Else
MsgBox Err.Number & " - " & Err.Description
' xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
Resume ShowName_End
End Sub 

Так себе пример - просто чтоб было…
Более того, работа с ячейками через Select получается медленной и на экране мельтешения. 

Word 

Создание документа Excel из Visio

Создание документа Excel из Visio 

Sub ttt()

' Dim xlApp As Excel.Application
Dim xlApp As Object

Const XL_NOTRUNNING As Long = 429

On Error GoTo ShowName_Err
Err.Clear

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

' Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then MsgBox "xlApp"
' xlApp.Visible = True
MsgBox xlApp.Worksheets.Count
If xlApp.ActiveSheet Is Nothing Then MsgBox "xlApp.ActiveSheet"
MsgBox "'" & xlApp.ActiveSheet.Name & "' is the currently active worksheet."

Range("A2").Select
ActiveCell.FormulaR1C1 = "1222777777777777777"
Range("B2").Select
ActiveCell.FormulaR1C1 = "22"
Range("C2").Select
ActiveCell.FormulaR1C1 = "34"
Range("A3").Select
' xlApp.ActiveWorkbook.SaveAs Filename:= _
' "C:\Documents and Settings\tumanov.CIT\Мои документы\Книга1.xls", FileFormat _
' :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
' False, CreateBackup:=False
' xlApp.Workbooks(1).Activate
' fName = xlApp.GetSaveAsFilename
fName = "C:\Documents and Settings\tumanov.CIT\Мои документы\Книга1.xls"

MsgBox xlApp.ActiveWorkbook.FullName

xlApp.DisplayAlerts = False
xlApp.ActiveWorkbook.SaveAs Filename:=fName
xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

ShowName_End:
Exit Sub
ShowName_Err:
If Err = XL_NOTRUNNING Then
' Excel is not currently running.
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

MsgBox "Version = " & xlApp.Version

Resume Next
Else
MsgBox Err.Number & " - " & Err.Description
' xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
Resume ShowName_End
End Sub 

Так себе пример - просто чтоб было…
Более того, работа с ячейками через Select получается медленной и на экране мельтешения. 

Word 

Составление отчета о имеющихся в документе примечаниях

Составление отчета о имеющихся в документе примечаниях 

Sub ttt()
Dim s As String
Dim comm As Comment

Set fs = CreateObject("Scripting.FileSystemObject")
Dim tmpName
tmpName = ActiveDocument.Path & "\testfile.txt"
Set a = fs.CreateTextFile(tmpName, True)

a.WriteLine ("<document>")
a.WriteLine ("<name>" & ActiveDocument.Name & "</name>")
a.WriteLine ("<autor>" & ActiveDocument.Creator & "</autor>")
a.WriteLine ("<CommentCount>" & ActiveDocument.Comments.Count & "</CommentCount>")
a.WriteLine ("<Comments>")
For Each comm In ActiveDocument.Comments
a.WriteLine ("<Item>")
a.WriteLine ("<author>" & comm.Author & "</author>")
a.WriteLine ("<scope>" & comm.Scope & "</scope>")
a.WriteLine ("<PageNumber>" & comm.Scope.Information(wdActiveEndPageNumber) & "</PageNumber>")
a.WriteLine ("<LineNumber>" & comm.Scope.Information(wdFirstCharacterLineNumber) & "</LineNumber>")
a.WriteLine ("<StartOf>" & comm.Reference.Start & "</StartOf>")
a.WriteLine ("<text>" & comm.Range.Text & "</text>")
a.WriteLine ("</Item>")
Next
a.WriteLine ("</Comments>")
a.WriteLine ("</document>")
a.Close
Dim NewName
With Dialogs(wdDialogFileSaveAs)
.Name = "tmpfile.txt"
.Display
NewName = ActiveDocument.Path & "\" & .Name
End With
Name tmpName As NewName
End Sub 

Отчет выводится в файл в формате близком к XML. Пример: 

<document>
<name>WorkFlow.doc</name>
<autor>1297307460</autor>
<CommentCount>2</CommentCount>
<Comments>
<Item>
<author>Ivanov</author>
<scope>рр</scope>
<PageNumber>1</PageNumber>
<LineNumber>9</LineNumber>
<StartOf>499</StartOf>
<text>Просто примечание</text>
</Item>
<Item>
<author>Ivanov</author>
<scope>Бывают многотомные </scope>
<PageNumber>1</PageNumber>
<LineNumber>12</LineNumber>
<StartOf>686</StartOf>
<text>Второе примечание</text>
</Item>
</Comments>
</document> 

Составление отчета о имеющихся в документе примечаниях

Составление отчета о имеющихся в документе примечаниях 

Sub ttt()
Dim s As String
Dim comm As Comment

Set fs = CreateObject("Scripting.FileSystemObject")
Dim tmpName
tmpName = ActiveDocument.Path & "\testfile.txt"
Set a = fs.CreateTextFile(tmpName, True)

a.WriteLine ("<document>")
a.WriteLine ("<name>" & ActiveDocument.Name & "</name>")
a.WriteLine ("<autor>" & ActiveDocument.Creator & "</autor>")
a.WriteLine ("<CommentCount>" & ActiveDocument.Comments.Count & "</CommentCount>")
a.WriteLine ("<Comments>")
For Each comm In ActiveDocument.Comments
a.WriteLine ("<Item>")
a.WriteLine ("<author>" & comm.Author & "</author>")
a.WriteLine ("<scope>" & comm.Scope & "</scope>")
a.WriteLine ("<PageNumber>" & comm.Scope.Information(wdActiveEndPageNumber) & "</PageNumber>")
a.WriteLine ("<LineNumber>" & comm.Scope.Information(wdFirstCharacterLineNumber) & "</LineNumber>")
a.WriteLine ("<StartOf>" & comm.Reference.Start & "</StartOf>")
a.WriteLine ("<text>" & comm.Range.Text & "</text>")
a.WriteLine ("</Item>")
Next
a.WriteLine ("</Comments>")
a.WriteLine ("</document>")
a.Close
Dim NewName
With Dialogs(wdDialogFileSaveAs)
.Name = "tmpfile.txt"
.Display
NewName = ActiveDocument.Path & "\" & .Name
End With
Name tmpName As NewName
End Sub 

Отчет выводится в файл в формате близком к XML. Пример: 

<document>
<name>WorkFlow.doc</name>
<autor>1297307460</autor>
<CommentCount>2</CommentCount>
<Comments>
<Item>
<author>Ivanov</author>
<scope>рр</scope>
<PageNumber>1</PageNumber>
<LineNumber>9</LineNumber>
<StartOf>499</StartOf>
<text>Просто примечание</text>
</Item>
<Item>
<author>Ivanov</author>
<scope>Бывают многотомные </scope>
<PageNumber>1</PageNumber>
<LineNumber>12</LineNumber>
<StartOf>686</StartOf>
<text>Второе примечание</text>
</Item>
</Comments>
</document> 

Выборка стилей из документа Word

Выборка стилей из документа Word 

Выбираются и записываются в файл стили всех параграфов. Документ загружается через диалоговое окно выбора. Сохранение выходного списка в текстовый файл. Имя также примается в диалоге.
Дополнительно – легкая раскраска в виде строки статуса и прогресс-бара. 

Dim appWD As Word.Application
Dim doc As Word.Document
On Error GoTo notloaded
Set appWD = GetObject(, "Word.Application")
notloaded:
If Err.Number = 429 Then
Set appWD = CreateObject("Word.Application")
theError = Err.Number
End If
appWD.Visible = True
'Нашли Word, открываем документ
PathInp = Text1.Text
On Error Resume Next
Set doc = appWD.Documents.Open(PathInp, True)
Set Convertor.docM = doc
Debug.Print Err.Number
Debug.Print doc.Paragraphs.Count
On Error GoTo 0
ProgressBar1.Max = doc.Paragraphs.Count
'=======Набор массива==========
StatusBar1.Panels(1).Text = "Прием стилей из документа"
ReDim StyArr(0)
For i = 1 To doc.Paragraphs.Count
st = doc.Paragraphs(i).Style
ReDim Preserve StyArr(i)
StyArr(i - 1) = st
ProgressBar1.Value = i
Next
ProgressBar1.Value = 0
If Check7.Value = 1 Then
'Сохранение массива в файл
If InPath = "" Then InPath = CurDir
CommonDialog1.InitDir = InPath
CommonDialog1.Filter = "Text files (*.txt)|*.txt"
CommonDialog1.DialogTitle = "Промежуточный список стилей"
CommonDialog1.ShowOpen
InPath = CurDir
TxtPath = CommonDialog1.FileName
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set a = fs.CreateTextFile(TxtPath, True)
On Error GoTo 0
For i = 0 To UBound(StyArr) - 1
a.WriteLN StyArr(i)
Next
a.Close
Set a = Nothing
Set fs = Nothing
MsgBox "Создан файл " & TxtPath
End If
'=======Конец набора массива========== 

Как создать документ Visio?

Как создать документ Visio из других приложений (например Excel)? Задача: Создать ( или открыть ) документ Visio из другого приложения. ( Excel, FoxPro и т.д.). Проходит команда CreatObject("Visio.Drawing.6"). А дальше ??? 

Вот пример, создающий рисунок Visio с привычной надписью "HelloWorld"
Берется Excel, вставляется в него этот макрос, (в VBA проекте нужно также не забыть подключить библиотеку типов Visio), запускается на выполнение.
Макрос создает экземпляр Visio, создает документ на основе шаблона Basic Diagram.vst (при этом открываются и соответствующие трафареты), перетаскивает с трафарета мастер-шейп Rectangle (квадрат) и вписывает в него текст "HelloWorld".
Потом в Excel'e сообщается о завершении работы через окно MsgBox.
После нажатия на кнопку OK Visio закрывается, а созданный рисунок сохраняется в файле hello.vsd. 

Sub HelloWorld()
Dim appVisio As Visio.Application 'Это экземпляр Visio
Dim docsObj As Visio.Documents 'Коллекция документов Visio
Dim docObj As Visio.Document 'Отдельный документ
Dim stnObj As Visio.Document ' Трафарет (Stencil)
Dim mastObj As Visio.Master ' Мастер-шейп, который будет перетаскиваться на рисунок
Dim pagsObj As Visio.Pages 'Коллекция страниц в документе
Dim pagObj As Visio.Page 'Отдельная страница
Dim shpObj As Visio.Shape 'Экземпляр мастер-шейпа
'Создается экземпляр Visio
Set appVisio = CreateObject("visio.application")
Set docsObj = appVisio.Documents
'Создается документ на основе шаблона
Set docObj = docsObj.Add("Basic Diagram.vst")
Set pagsObj = appVisio.ActiveDocument.Pages
'Выбирается из коллекции первая страница документа
Set pagObj = pagsObj.Item(1)
Set stnObj = appVisio.Documents("Basic Shapes.vss")
Set mastObj = stnObj.Masters("Rectangle")
'Перетаскивается с трафарета Basic Shapes.vss шейп Rectangle
Set shpObj = pagObj.Drop(mastObj, 4.25, 5.5)
'и в нем пишется текст
shpObj.Text = "Hello World!"
'сохраняется полученный документ
docObj.SaveAs "hello.vsd"
MsgBox "Нарисовано!", , "Hello World!"
'Закрывается Visio
appVisio.Quit
End Sub
&nbsp; 

Как сохранить документ в формате .htm?

.SaveAs (...htm) пишет неправильно. 

Существует метод Export, с помощью которого все делается.
Вот информация из Хелпа. Метод Export экспортирует объект Visio в файлы таких форматов как .pcx, .eps, или .htm.
Синтаксис object.Export fileName.
Object - выражение, возвращающее экспортируемый объект Page, Master, Selection, или Shape.
FileName - полный путь и имя файла для сохранения экспортируемого объекта.
Примечание. Тип преобразования при экспорте определяется расширением файла. Если соответствующий фильтр не установлен, метод Export возвращает ошибку.
Метод использует установки "по умолчанию" соответствующего фильтра и не принимает дополнительных аргументов.
Метод Export, примененный к странице (Page), поддерживает сохранение ее в файле HTML формата с расширением .htm или .html. Страница экспортируется с установками, использованными последний раз при выполнении диалога Save As.
Если заданный файл уже существует, он перезаписывается без дополнительных подтверждений.
Дополнение. Export обязательно требует полный путь.
Вот это у меня работает: pagObj.Export "g:\hello.htm" 

Как можно вставить Visio в Word?

Есть документ в ворде и документ в визио (страниц много). В ворде делаю ThisDocument.Shapes.AddOLEObject "Visio.Drawing", File_vsd, , , , , , 75, 75, 400, 450, Selection.Range
Но это только первая страница, а нужно вставить в Word страницы из Visio одна за другой(не обязательно в том же порядке, как в Visio), под рисунок написать: Рис. "N"-i "appVisio.ActiveDocument.Pages.Item(i)" , за ней следующую и т.д. 

Вставляя OLE объект из файла Вы вставляете весь многостраничный документ, а не только первую страницу. Тем более, что вставляется не первая страница, а та, на которой был закрыт документ Visio, например, последняя или пятая. Если сделать ту же операцию вручную из меню Word, то во вставленном объекте можно переходить с одной страницы на другую. Можно вставить объект два раза в разные места, а потом в одном из них перейти на другую страницу, и в Word'е Вы увидите две разные картинки. Если Вы хотите вставить несколько объектов, отображающих по умолчанию разные страницы рисунка Visio, то это будут просто копии одного и того же объекта, но открытые на разных страницах.
Как иллюстрация работает такой вариант:
Документ Visio был сохранен на третьей странице. Программка делает следующее:
вставляет третью страницу (первый AddOle), перелистывает файл на первую страницу,
вставляет первую страницу (второй AddOle). 

ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Visio.Drawing", DisplayAsIcon:=False, _
FileName:="g:\Business\MP\Orders\importer.vsd", _
Range:=ActiveDocument.Paragraphs(2).Range
On Error Resume Next
Dim appObj As Visio.Application
Set appObj = CreateObject("Visio.Application")
If appObj Is Nothing Then
MsgBox "Failed creating Visio instance."
Else
' MsgBox "ProcessID: " & appObj.ProcessID
' appObj.Visible = True
End If
Set docsObj = appObj.Documents.Open("g:\Business\MP\Orders\importer.vsd")
Set pagsObj = docsObj.Pages
appObj.ActiveWindow.Page = "Page-1"
appObj.ActiveDocument.Save
appObj.Quit
ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Visio.Drawing", DisplayAsIcon:=False, _
FileName:="g:\Business\MP\Orders\importer.vsd", _
Range:=ActiveDocument.Paragraphs(3).Range 

Возможен и другой вариант - вставлять объекты не из файла, а открыть приложение Visio, не закрывая листать его и передавать объекты через Clipboard. 

Как программно добавить трафарет (*.vss) в уже открытый документ?

Как программно добавить трафарет (*.vss) в уже открытый документ, чтоб он попал в группу Shapes в левой части документа. Это можно вручную сделать так:
File->Stencils->Open Stencil
но
Dim appVisio As Object, dc As Visio.Document
Set dc = appVisio.Documents.Add("...El.vss")
или Set dc = appVisio.Documents.Open("...El.vss")
открывают его, но в отдельном окне, не добавленном в группу Shapes исходного документа 

Мне кажется немного не так.
File->Stencils->Open Stencil
ничего не добавляет в группу Shapes исходного документа. Открывается новый документ с трафаретом. Только этот трафарет, что называется docked, на первом документе. И его компоненты лежат в коллекции Masters этого второго документа.
Такой же эффект дает использование OpenEx с указанием, как открывать. Например: 

Dim ds As Visio.Document
Set ds = Application.Documents.OpenEx("Blocks.vss", visOpenDocked)
MsgBox Documents(1).Name
MsgBox Documents(2).Name