Sub
Icons2Visio()
Dim
UndoScopeID1
As
Long
UndoScopeID1 = Application.BeginUndoScope(
"Importieren"
)
Application.ActiveWindow.Page.Import
"C:\Users\rnb\Pictures\ Icons_SVG\adjust.svg"
Application.EndUndoScope UndoScopeID1,
True
Dim
UndoScopeID2
As
Long
UndoScopeID2 = Application.BeginUndoScope(
"Füllbereichseigenschaften"
)
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU =
"THEMEGUARD(RGB(255,255,255))"
Application.ActiveWindow.Page.Shapes.ItemFromID(1).Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU =
"THEMEGUARD(RGB(255,255,255))"
Application.EndUndoScope UndoScopeID2,
True
Application.ActiveWindow.SetViewRect -11.777778, 18.527778, 37.861111, 21.333333
Application.ActiveWindow.SetViewRect -31.166667, 33.277778, 75.722222, 42.666667
Dim
UndoScopeID3
As
Long
UndoScopeID3 = Application.BeginUndoScope(
"Objektgröße ändern"
)
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU =
"91.604166666667 p"
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU =
"-12.479166666667 p"
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU =
"1.2083333333333 p"
Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU =
"1.2083333333333 p"
Application.EndUndoScope UndoScopeID3,
True
Dim
UndoScopeID4
As
Long
UndoScopeID4 = Application.BeginUndoScope(
"Auf Schablone ablegen"
)
ActiveWindow.DeselectAll
ActiveWindow.
Select
Application.ActiveWindow.Page.Shapes.ItemFromID(1), visSelect
Dim
vsoSelection1
As
Visio.Selection
Set
vsoSelection1 = ActiveWindow.Selection
Dim
vsoDoc1
As
Visio.Document
Set
vsoDoc1 = Application.Documents.Item(
"Schablone5.vss"
)
vsoDoc1.Drop vsoSelection1, 0#, 0#
vsoSelection1.Delete
Application.EndUndoScope UndoScopeID4,
True
End
Sub