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

Документы

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

03.03.2021  Viewing Visio Document Changes in Git   David Parker    

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 ("") a.WriteLine ("" & ActiveDocument.Name & "") a.WriteLine ("" & ActiveDocument.Creator & "") a.WriteLine ("" & ActiveDocument.Comments.Count & "") a.WriteLine ("") For Each comm In ActiveDocument.Comments a.WriteLine ("") a.WriteLine ("" & comm.Author & "") a.WriteLine ("" & comm.Scope & "") a.WriteLine ("" & comm.Scope.Information(wdActiveEndPageNumber) & "") a.WriteLine ("" & comm.Scope.Information(wdFirstCharacterLineNumber) & "") a.WriteLine ("" & comm.Reference.Start & "") a.WriteLine ("" & comm.Range.Text & "") a.WriteLine ("") Next a.WriteLine ("") a.WriteLine ("") a.Close Dim NewName With Dialogs(wdDialogFileSaveAs) .Name = "tmpfile.txt" .Display NewName = ActiveDocument.Path & "\" & .Name End With Name tmpName As NewName End Sub  

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

WorkFlow.doc 1297307460 2 Ivanov рр 1 9 499 Просто примечание Ivanov Бывают многотомные 1 12 686 Второе примечание  

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

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

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 ("") a.WriteLine ("" & ActiveDocument.Name & "") a.WriteLine ("" & ActiveDocument.Creator & "") a.WriteLine ("" & ActiveDocument.Comments.Count & "") a.WriteLine ("") For Each comm In ActiveDocument.Comments a.WriteLine ("") a.WriteLine ("" & comm.Author & "") a.WriteLine ("" & comm.Scope & "") a.WriteLine ("" & comm.Scope.Information(wdActiveEndPageNumber) & "") a.WriteLine ("" & comm.Scope.Information(wdFirstCharacterLineNumber) & "") a.WriteLine ("" & comm.Reference.Start & "") a.WriteLine ("" & comm.Range.Text & "") a.WriteLine ("") Next a.WriteLine ("") a.WriteLine ("") a.Close Dim NewName With Dialogs(wdDialogFileSaveAs) .Name = "tmpfile.txt" .Display NewName = ActiveDocument.Path & "\" & .Name End With Name tmpName As NewName End Sub  

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

WorkFlow.doc 1297307460 2 Ivanov рр 1 9 499 Просто примечание Ivanov Бывают многотомные 1 12 686 Второе примечание  

Выборка стилей из документа 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    

Как сохранить документ в формате .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