![]() |
Форум visio.getbb.ru | О форумах Библиотека | Частые вопросы | Литература | Склад материалов Visio Navigator | Blog | Полезные ссылки | О сайте История Visio | Продукты Visio |
Для русскоязычных пользователей 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 ("<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
Как сохранить документ в формате .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