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)
Главная (Апшеронск)



Рейтинг@Mail.ru


 
 
Разделы сайта:
Апшеронск Спорт VBA Форекс Сочи-2014 Нейросети Студентам
Связь с Администратором сайта, E-mail: apsheronka@mail.ru
Апшеронск, Краснодарский край

Размещение рекламы на сайте
Карта сайта

При перепечатке материалов сайта http://apsheronsk.bozo.ru - обязательная активная гиперссылка на сайт!


интернет магазин входных дверей
бесплатная доставка цветов