Animation mit Visio

Ein bisschen Spielerei, ein paar Zeilen Code.
Ja, ja, ich weiß: Visio ist sicherlich nicht das beste Programm, um solche „Zeichnungen“ zu animieren. Dennoch: wer den Code einsehen möchte: (in der Routine „Verzögern“ ist eine Schleife und der Befehl DoEvents eingebaut – sonst wäre das Glas zu schnell fertig).

Set vsShape = ActivePage.DrawRectangle(2, 2, 6, 8)
With vsShape
.Cells(„Geometry1.Y3“).FormulaU = „=Width*0“
.Cells(„Geometry1.Y4“).FormulaU = „=Width*0“
.Cells(„Geometry1.X5“).FormulaU = „=Width*0“
.Cells(„Geometry1.Y5“).FormulaU = „=Height*0“

ActiveWindow.DeselectAll: Verzögere

.Cells(„Geometry1.NoFill“).FormulaU = „=True“
.Cells(„Geometry1.X1“).FormulaU = „=Width*0.6“
.Cells(„Geometry1.Y1“).FormulaU = „=Height*0.1“: Verzögere
.Cells(„Geometry1.X2“).FormulaU = „=Width*1“
.Cells(„Geometry1.Y2“).FormulaU = „=Height*0“
.Cells(„Geometry1.X3“).FormulaU = „=Width*0“
.Cells(„Geometry1.Y3“).FormulaU = „=Height*0“
.Cells(„Geometry1.X4“).FormulaU = „=Width*0.5“
.Cells(„Geometry1.Y4“).FormulaU = „=Height*0.15“: Verzögere
.Cells(„Geometry1.X5“).FormulaU = „=Width*0.5“
.Cells(„Geometry1.Y5“).FormulaU = „=Height*0.6“: Verzögere
.AddRow visSectionFirstComponent, 6, visTagLineTo
.Cells(„Geometry1.X6“).FormulaU = „=Width*0“
.Cells(„Geometry1.Y6“).FormulaU = „=Height*1“
.AddRow visSectionFirstComponent, 7, visTagLineTo
.Cells(„Geometry1.X7“).FormulaU = „=Width*0.5“
.Cells(„Geometry1.Y7“).FormulaU = „=Height*0.6“: Verzögere
.AddRow visSectionFirstComponent, 8, visTagLineTo
.Cells(„Geometry1.X8“).FormulaU = „=Width*1“
.Cells(„Geometry1.Y8“).FormulaU = „=Height*1“
.AddRow visSectionFirstComponent, 9, visTagLineTo
.Cells(„Geometry1.X9“).FormulaU = „=Width*0.75“
.Cells(„Geometry1.Y9“).FormulaU = „=Height*0.8“: Verzögere
.AddRow visSectionFirstComponent, 10, visTagLineTo
.Cells(„Geometry1.X10“).FormulaU = „=Width*0.25“
.Cells(„Geometry1.Y10“).FormulaU = „=Height*0.8“: Verzögere

intAbschnitt = .AddSection(visSectionLast)

.AddRow intAbschnitt, visRowComponent, visTagComponent
.AddRow intAbschnitt, 1, visTagRelMoveTo
.AddRow intAbschnitt, 2, visTagEllipticalArcTo
.Cells(„Geometry2.X1“).FormulaU = „=0.5“
.Cells(„Geometry2.Y1“).FormulaU = „=1“
.Cells(„Geometry2.X2“).FormulaU = „=Width*0.125“
.Cells(„Geometry2.Y2“).FormulaU = „=Height*0.65“
.Cells(„Geometry2.A2“).FormulaU = „=-Width*0.25“
.Cells(„Geometry2.B2“).FormulaU = „=Height*1“
.Cells(„Geometry2.NoFill“).FormulaU = „=True“: Verzögere

.Cells(„LineWeight“).FormulaU = „=30 pt“

End With