Kategorie: VBA

Ein paar Zeilen Code und schon entsteht ein „Zufallskunstwerk“.
Auf die Idee hat mich François Morellet gebracht – mit seiner Ausstellung in Caen.
Und hier der Code:
Dim i As Integer

ActiveWindow.SelectAll
ActiveWindow.Selection.Delete

Randomize

For i = 1 To 100
ActivePage.DrawLine 8.2 * Rnd, 8.2 * Rnd, 8.2 * Rnd, 11.8 * Rnd
Next

ActiveWindow.DeselectAll

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

Hallo Herr Martin,

zum Zweck:
Ich glaube schon, dass es für einen Nutzer ganz praktisch ist, wenn ein Programm (sei es z.B. ein Bildbetrachtungsprogramm mit unterlegten Texten u. vieles mehr) sich direkt aus der Windowsoberfläche starten lässt – und dann direkt ins Vollbild.
So sind ja nur noch die Button und die programmtechnischen Funktionen aktiv. Alles andere ist gesperrt.

Das Vollbild im Programm aufzurufen ist inzwischen mit  ‚ SendKeys „{F5}“  ‚ unproblematisch.
Der Automatikstart dagegen noch nicht.

Ein Durchstarten aus der Windowsoberfläche gelingt mir  für ein einfaches Visio-Programm  mit der im Internet gefundenen Aufrufzeile:

Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
‚hier der gewünschte Programmaufruf z.B. Call Hauptprogramm
End Sub

Bei meinem komplexeren Programm startet das Programm jedoch ins Nirwana.

Können Sie mir erklären, wie dies überhaupt funktioniert? Welche Randbedingungen gibt es? Was kann falsch laufen?

####
Hallo Herr F.,

Sie dürfen den Code nicht in Modul einfügen, sondern müssen im VBA-Editor unter

ThisDocument

auf der Liste der Objekte das Objekt „Document“ auswählen. Dann erscheint das Ereignis „Open“ (weitere Ereignisse rchts oben in der Dropdownliste):

Dann klappt es (möglicherweise müssen Sie noch die Makros aktivieren oder in Vertrauensstellungscenter etwas ändern. Und: nicht vergessen: Die Datei von Typ *. vsdm“ (mit Makros) zu speichern

schöne Grüße

Rene Martin

Eine rekursive Funktion zu schreiben, die alle Shapes (auch die Shapes in Gruppen) auflistet, ist nicht sehr schwierig:

Private Sub BistDuGruppe(vsshape As Visio.Shape)
Dim i As Long
ReDim Preserve lngShapeID(UBound(lngShapeID) + 1) ‚ — vergrößere die Dimension
lngShapeID(UBound(lngShapeID)) = vsshape.ID
If LiegstDuAufRichtigemLayer(vsshape) = False Then
For i = 1 To vsshape.Shapes.Count
Call BistDuGruppe(vsshape.Shapes(i))
Next i
End If
End Sub

An Datenfelder eines Shapes, das ein technisches Gerät darstellt, werden Informationen gebunden. Mit ein paar Zeilen Code können diese auf dem Shape angezeigt werden:
If Left(vsShape.Name, Len(„Abbott_i2000“)) = „Abbott_i2000“ Then
For i = 1 To 7
If vsShape.CellExists(„User.NodeIdentifier“ & i, False) Then
Set vsMaster = vsSchablone.Masters(„Identifier“)
Set vsIDRechteck = ActivePage.Drop(vsMaster, 1, 1)
With vsIDRechteck
If vsShape.Cells(„Angle“).Result(„deg“) = 0 Then
Select Case i
Case 1
.Cells(„PinX“).Result(„m“) = vsShape.Cells(„PinX“).Result(„m“) – 0.95
.Cells(„PinY“).Result(„m“) = vsShape.Cells(„PinY“).Result(„m“) + 0.25
Case 2
.Cells(„PinX“).Result(„m“) = vsShape.Cells(„PinX“).Result(„m“) – 0.3
.Cells(„PinY“).Result(„m“) = vsShape.Cells(„PinY“).Result(„m“) + 0.25
Case 3
.Cells(„PinX“).Result(„m“) = vsShape.Cells(„PinX“).Result(„m“) + 0.1
.Cells(„PinY“).Result(„m“) = vsShape.Cells(„PinY“).Result(„m“) + 0.25
Case 4
.Cells(„PinX“).Result(„m“) = vsShape.Cells(„PinX“).Result(„m“) + 0.3
.Cells(„PinY“).Result(„m“) = vsShape.Cells(„PinY“).Result(„m“) + 0.25
Case 5
[…]

Um so ein Hyperlink-Shape zu erzeugen, das den Hyperlink-Dialog beim Herausziehen aus der Schablone öffnet, muss im ShapeSheet in der Zelle EventDrop der Befehl =DOCMD(1585) eingefügt werden. Warum 1585? Diese Zahl steht für die Konstante visCmdInsertHyperLink, die man in VBA im Objektkatalog in der Klasse VisUICmds

Wie gut, dass man den Assistenten per Makrorekorder aufzeichnen kann. Zwar kann man nicht in den Assistenten eingreifen, aber die Zeile:
Set drs = Application.ActiveDocument.DataRecordsets.Add“ _
„(Provider=Microsoft.ACE.OLEDB.12.0;“ & _
„User ID=Admin;Data Source=“ […]
kann verändert werden. Somit ist es möglich vor dem Assistenten eine Auswahl zu treffen (über eine Combobox), diese Daten zurück nach Access, Excel oder in den SQL-Server zu schreiben und dann diese gefilterten Daten in die Zeichnung zu importieren.

Warum müssen Hilfedateien immer lokal liegen? Microsoft macht es vor und lagert die Hilfedateien ins Internet aus. Der Vorteil: sie können schneller aktualisiert werden. In Visio 2013 kann man so etwas über ein Symbol aufrufen, beispielsweise so:
Public Sub cmdHelp(ByRef control As IRibbonControl)
Dim wshShell As Object
Set wshShell = CreateObject(„WScript.Shell“)
wshShell.Run „http:www.visio-training.de/
End Sub

Ein bisschen schwierig solche Topologien durchzurechnen – aber es funktioniert.