Hallo nochmals
Bis anhin konnte mir leider noch niemand helfen. Ich habe nun versucht, das selber zu machen. Allerdings scheitere ich an der Auswahl meherer Dateien. Im momentanen Zustand wir nur 1 Datei namens "adjust.svg" imortiert u. verkleinert. Hat mir jemand einen Tipp, wie ich das Script anweisen kann mit allen Dateien im SVG Ordner auf diese Weise zu verfahren? Hier das Script, wie es momentan aussieht:
Sub Icons2Visio()
'
' Mehrere SVGs importieren
'
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
Vielen Dank für eure Hilfe.
Beste Grüsse
rnb
|