Access -> Visio
Примеры кода
>>>>>>>>>>>>>>>>>>>>
Вставка картинки с подписью в указанное место на листе
Visio
Function MakeLS(Vizz As Object)
' Заполняем Лист Согласований
с подписями
Vis.ActiveWindow.Page.Shapes.ItemFromID(90).Characters.Text = GIP
Vis.ActiveWindow.Page.Shapes.ItemFromID(91).Characters.Text = Chief_otdel
Vis.ActiveWindow.Page.Shapes.ItemFromID(92).Characters.Text = Razrabotal
Vis.ActiveWindow.Page.Shapes.ItemFromID(29).Characters.Text = Proveril
Vis.ActiveWindow.Page.Shapes.ItemFromID(94).Characters.Text = Normo
Vis.ActiveWindow.Page.Shapes.ItemFromID(11).Characters.Text = Project_name
Vis.ActiveWindow.Page.Shapes.ItemFromID(12).Characters.Text = Our_Firma
'Vis.ActiveWindow.Page.Shapes.ItemFromID(10).Characters.Text = Shifr_project
'Vis.ActiveWindow.Page.Shapes.ItemFromID(13).Characters.Text = Stadia_project
sql = "SELECT Podpis
FROM People WHERE Short_name = '" + Trim(CStr(GIP)) + "'"
Set r = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
Vizz.ActiveWindow.Page.Import
(CStr(r.Fields("Podpis")))
Vizz.ActiveWindow.Selection.Move
-1.420686, -4.708005
Vizz.ActiveWindow.Selection.SendToBack
……
End Function
>>>>>>>>>>>>>>>>>>>>>>>>>>.
Пример вставки оборудования на лист Visio из наборов
элементов Visio
Function InsertEquipment(kolvo As Integer)
' по Koord
расставляем объекты внутри помещения
ii = ObjectsDistribution(kolvo)
Dim obj
As Variant
Dim chet
As Integer ' четный/нечетный ряд
ReDim
Object_ID(kolvo - 1)
Vis.Documents.OpenEx
"G:\Набор_элементов.vss", visOpenRO + visOpenDocked
Set figa
= Vis.Documents.Item("G:\Набор_элементов.vss").Masters.ItemU("Master.3")
Vis.Windows.ItemEx(File_1).Activate '
перемещаемся на лист с чертежем и вставляем
For i = 0 To kolvo - 1 Step 1
'Vis.ActiveWindow.Page.Drop
Vis.Documents.Item("G:\Набор_элементов.vss").Masters.ItemU("Master.3"), Koord(i, 0), Koord(i,
1)
Set obj
= Vis.ActiveWindow.Page.Drop(figa, Koord(i, 0), Koord(i,
1))
Object_ID(i)
= obj.ID
Next i
' Dim
vsoShape2 As Visio.Shape
' Set
vsoShape2 = Application.ActiveWindow.Page.Drop(Application.ConnectorToolDataObject, 2.941667, 7.01)
' Application.ActivePage.Shapes.ItemFromID(237).AutoConnect Application.ActivePage.Shapes.ItemFromID(240),
visAutoConnectDirNone
' делаем коннекты между элементами
chet = 0
For i = 0 To kolvo - 2 Step 1
If ((CInt((i
+ 1) / sav) - (i + 1) / sav) = 0) And (i < kolvo - 1) Then
If chet
= 0 Then
zz = Vis.ActivePage.Shapes.ItemFromID(Object_ID(i)).AutoConnect(Vis.ActivePage.Shapes.ItemFromID(Object_ID(i + sav)), 0)
chet = 1
Else
zz = Vis.ActivePage.Shapes.ItemFromID(Object_ID(i - sav
+ 1)).AutoConnect(Vis.ActivePage.Shapes.ItemFromID(Object_ID(i + 1)), 0)
chet = 0
End If
Else
zz = Vis.ActivePage.Shapes.ItemFromID(Object_ID(i)).AutoConnect(Vis.ActivePage.Shapes.ItemFromID(Object_ID(i + 1)), 0)
End If
Next i
If kolco
= True Then ' замыкаем в кольцо
zz = Vis.ActivePage.Shapes.ItemFromID(Object_ID(0)).AutoConnect(Vis.ActivePage.Shapes.ItemFromID(Object_ID(kolvo - 1)), 0)
End If
End Function
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Пример работы с рекордсетом
Function Init()
Dim r As
Recordset
' Инициализация переменных
X1 = 2 ' определяем угол
фигуры
Y1 = 4.5
XY = 0.5
Wall = 0.2
Zazor = 0.2
Radius = 0.3
Object_MaxMin = False
kolco = True
WindowsArray = Array(0,
0, 0, 0)
sql = "select *
from Passport where id_passport = 1"
Set r = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If r.EOF And r.BOF Then Exit Function
r.MoveFirst
Executor_full
= r.Fields("Executor_full")
Executor_short
= r.Fields("Executor_short")
System_name
= r.Fields("System_name")
Project_name
= r.Fields("Project_name")
Contract = r.Fields("Contract")
Shifr_project
= r.Fields("Shifr_project")
Year_project
= r.Fields("Year_project")
r.Close
….
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Пример рисования в Visio из под Access
Set Vis = CreateObject("Visio.Application")
Vis.Visible = False
Function DrawDoors_Windows(Vizz As Variant)
' отрисовка
окон и дверей. Надо учесть (!!!!) куда смотрит ширина,на север...
'Vizz.ActiveWindow.Page = Vis.ActiveDocument.Pages.Item("АСП")
SC = MakeScale(dlina, shirina)
Wall = Wall ' перемасштабируем стенку
Vizz.ActiveDocument.GestureFormatSheet.CellsSRC(1, 2, 0).FormulaU = "2.16 pt" ' толстая линия
Vizz.ActiveWindow.Page.DrawRectangle X1, Y1, X1 + dlina * SC, Y1 + shirina * SC ' внешний прямоугольник
Vizz.ActiveWindow.Page.DrawRectangle X1 + Wall, Y1 +
Wall, X1 + dlina * SC - Wall, Y1 + shirina * SC - Wall ' внутренний прямоугольник
'Vis.ActiveWindow.Selection.GestureFormatSheet.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU "4"
X2 = X1 + dlina
* SC 'верхний угол
Y2 = Y1 + shirina
* SC
' ставим размеры – длина
Vizz.ActiveDocument.GestureFormatSheet.CellsSRC(1, 2,
0).FormulaU
= "2.16 pt"
' толстая линия
Vizz.ActiveDocument.GestureFormatSheet.CellsSRC(1, 2, 0).FormulaU = "0.72 pt" ' толстая линия
Vizz.ActiveWindow.Page.DrawLine X1, Y1 - XY, X1 + dlina * SC, Y1 - XY ' главная линия размера
Vizz.ActiveWindow.Page.DrawLine X1 + Wall, Y1 +
Wall, X1 + Wall, Y1 - XY - Zazor ' боковые полочки
Vizz.ActiveWindow.Page.DrawLine X2 - Wall, Y1 +
Wall, X2 - Wall, Y1 - XY - Zazor
Vizz.ActiveWindow.Page.DrawLine X1 + Wall - Zazor / 2, Y1 - XY, X1 + Wall + Zazor
/ 2, Y1 - XY '1-я засечка на перекрестье линии размеров
Vizz.ActiveWindow.Selection.Rotate -45, visDegrees
Vizz.ActiveWindow.Page.DrawLine X2 - Wall - Zazor / 2, Y1 - XY, X2 - Wall + Zazor / 2, Y1 - XY '2-я засечка на перекрестье линии
размеров
Vizz.ActiveWindow.Selection.Rotate -45, visDegrees
' пишем длину
Set TT = Vizz.ActiveWindow.Page.DrawRectangle(X1
+ dlina * SC / 2 - XY, Y1 - 2 * XY, X1 + dlina * SC / 2 + XY, Y1 - XY)
TT.LineStyle = "Text Only"
TT.FillStyle = "Text Only"
TT.Text = CStr(dlina)
………………
' закрашиваем белым
Vizz.ActiveDocument.GestureFormatSheet.CellsSRC(1, 2, 1).FormulaU =
"THEMEGUARD(RGB(255,255,255))"
………………
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Макрос VBA из Excel в Access
Макрос VBA из RSS-ленты в Access
Макрос VBA из текстового файла в Access
Примеры макросов работы с Visio из под Access
Пример макроса для работы в Power Point
Конструктор тестов из Экселя в Ворд (на VBA)
Главная (Апшеронск)
