Kategorie: VBA

DrawOval

In Visio kann man mit dem Befehl DrawRectangle und DrawOval ein Rechteck, beziehungsweise eine Ellipse zeichnen. Wer braucht denn so etwas?
Sie können diese Funktion verwenden, um in einer »durchgerechneten« Zeichnung Shapes kennzeichnen, die richtig positioniert, geklebt, beschriftet, … wurden. In folgendem Code wurden sämtliche Shapes in einem Datenfeld »eingesammelt« und dann ausgewertet. Die Shapes, die nicht verbunden sind, werden durch einen roten Punkt gekennzeichnet:
If InStr(1, ActivePage.Shapes(strVerbindername).Cells(„EndX“). _
FormulaU, „_WALKGLUE“) > 0 Then ‚ — falls V. dynamisch klebt
blnKlebtNicht = True: blnMindestensEinerKlebtNicht = True
Set vsShape = ActivePage.DrawOval(ActivePage.Shapes( _
strVerbindername).Cells(„PinX“).Result(„in“) – 0.5, _
ActivePage.Shapes(strVerbindername).Cells(„PinY“).Result(„in“) _
– 0.5, ActivePage.Shapes(strVerbindername).Cells(„PinX“). _
Result(„in“) + 0.5, ActivePage.Shapes(strVerbindername). _
Cells(„PinY“).Result(„in“) + 0.5)
vsShape.Cells(„FillForegnd“).FormulaU = „=2“ ‚ — rot
vsShape.Text = „Verbindungsfehler“
vsShape.AddSection visSectionProp
vsShape.AddRow visSectionProp, 1, 0
vsShape.Section(visSectionProp).Row(0).Name = _
„Verbindungsfehler“
[…]

Größe der Festplatte visualisieren

Ein paar Zeilen Code und man kann sich die Größe der Festplatte visualisieren lassen:
Sub Festplatte()
Dim lngFestplattengröße As Double
Dim lngFreierPlatz As Double
Dim i As Integer
lngFestplattengröße = GetDriveSpace(Left(Application.Path, 2), DRIVE_TOTALSIZE) / 1000000
For i = 1 To 6
ActivePage.Shapes(„Text“ & i).Text = Format(Int(lngFestplattengröße / 7) * i / 1000, „#,##0“)
Next i
 
ActivePage.Shapes(„Gesamt“).Text = „Gesamtgröße der Festplatte: “ & Format(lngFestplattengröße, „#,##0″) & “ GByte“
 
lngFreierPlatz = GetDriveSpace(Left(Application.Path, 2)) / 1000000
ActivePage.Shapes(„Zeiger“).Cells(„Angle“).ResultFromInt(81) = 90 – (lngFreierPlatz / lngFestplattengröße) * 270
ActivePage.Shapes(„Zeiger“).Cells(„Angle“).Formula = „=“ & (90 – (lngFreierPlatz / lngFestplattengröße) * 270) & “ grad“
End Sub
Okay – man benötigt noch eine FUnktion, die die Größe der Festplatte und den belegten Speicher anzeigt. Beispielsweise folgende:
Public Enum eSpaceType
DRIVE_FREESPACE = 1
DRIVE_TOTALSIZE = 2
End Enum
 
‚ Freien Speicherplatz/Gesamtgröße eines Laufwerks ermitteln
Public Function GetDriveSpace(ByVal sDrive As String, _
Optional ByVal nSpaceType As eSpaceType = DRIVE_FREESPACE) As Currency
Dim oWMI As Object
Dim oDrives As Object
Dim sSQL As String
Dim oDrive As Object
sSQL = „SELECT * FROM Win32_LogicalDisk WHERE DeviceID = ‚“ & sDrive & „‚“
Set oWMI = GetObject(„winmgmts:“)
Set oDrives = oWMI.ExecQuery(sSQL)
If Not oDrives Is Nothing Then
If oDrives.Count > 0 Then
For Each oDrive In oDrives
If nSpaceType = DRIVE_FREESPACE Then
‚ freien Speicherplatz zurückgeben
GetDriveSpace = oDrive.FreeSpace
Else
‚ Gesamtgröße des Datenträgers zurückgeben
GetDriveSpace = oDrive.Size
End If
Exit For
Next
End If
End If
Set oDrives = Nothing
Set oWMI = Nothing
End Function

Verzeichnisse visualisieren

Mit ein bisschen VBA kann man in Visio leicht die Ordnerstruktur visualisieren lassen:
Dazu benötigen Sie einige globale Variablen für die Zeilen- und Spaltennummern, die Visio-Datei, das zuletzt erstellte Shape und den Namen des Verzeichnisses:
Dim dblEbene As Double
Dim dblZeile As Double
Dim blnNeueZeile As Boolean
Dim vsDatei As Document
Dim vsSeite As Page
Dim strVerzeichnis As String
Dim vsRechteck As Shape
 
Der Ordner wird ausgewählt, eine neue Datei erstellt und auf die erste Seite zugegriffen. Das rekursive Programm wird aufgerufen.
Sub ListeVerzeichnisAuf()
Dim fso As FileSystemObject
Dim fsoVerzeichnis1 As Folder
Set fso = New FileSystemObject
strVerzeichnis = VerzeichnisAuswählen(„Bitte Verzeichnis auswählen!“)
If strVerzeichnis = „“ Then
MsgBox „Es wurde kein Verzeichnis ausgewählt“
Else
Set fsoVerzeichnis1 = fso.GetFolder(strVerzeichnis)
Set vsDatei = Application.Documents.Add(„“)
Set vsSeite = vsDatei.Pages(1)
dblEbene = 0: dblZeile = 11
blnNeueZeile = False
ZeigeVerzeichnis fsoVerzeichnis1
 
Das eigentliche Programm generiert Rechtecke, die an die entsprechende Position gesetzt und mit dem Verzeichnisnamen beschriftet werden.
Sub ZeigeVerzeichnis(ByVal fsoVerzeichnis1 As Folder)
Dim fsoVerzeichnis2 As Folder
dblEbene = dblEbene + 1.5
For Each fsoVerzeichnis2 In fsoVerzeichnis1.SubFolders
Set vsRechteck = vsSeite.DrawRectangle( _
dblEbene, dblZeile, dblEbene + 1.5, dblZeile – 0.5)
vsRechteck.Text = „\“ & fsoVerzeichnis2.Name
blnNeueZeile = False
ZeigeVerzeichnis fsoVerzeichnis2
Next
dblEbene = dblEbene – 1.5
If dblEbene = 1.5 Then
dblZeile = dblZeile – 0.25
End If
‚ — trenne die Hauptverzeichnisse voneinander
If blnNeueZeile = False Then
dblZeile = dblZeile – 0.5
blnNeueZeile = True
End If
‚ — nur das erste Mal eine Zeile tiefer
End Sub
 
Nach Beendigung wird die Seite an die benötigte Größe angepasst und der Name des ausgewählten Verzeichnisses in ein Überschriften-Shape geschrieben.
vsSeite.AutoSizeDrawing
Set vsRechteck = vsSeite.DrawRectangle( _
vsSeite.PageSheet.Cells(„PageWidth“).Result(„in“) / 2 – 3, _
vsSeite.PageSheet.Cells(„PageHeight“).Result(„in“) – 1, _
vsSeite.PageSheet.Cells(„PageWidth“).Result(„in“) / 2 + 3, _
vsSeite.PageSheet.Cells(„PageHeight“).Result(„in“) + 0)
vsRechteck.Text = strVerzeichnis
strVerzeichnis = „“
ActiveWindow.DeselectAll

Application.Path

Das oberste oder erste Objekt in Visio – wie in allen Anwendungsprogrammen von Microsoft – ist Application. Damit wird das Programm, also Visio selbst, bezeichnet. Auf dieses Objekt kann zugegriffen werden. Dies ist interessant, wenn Sie nicht mit VBA innerhalb von Visio, sondern extern, das heißt mit VS.NET (VB.NET oder C#), mit Visual Basic, C++ oder einer anderen Programmiersprache auf Visio zugreifen. Oder auch, wenn Sie von einem anderen Programm, beispielsweise von Excel, Access oder Word auf Visio zugreifen.
Innerhalb von Visio bietet das Objekt Application auf den ersten Blick wenig interessante Informationen.
Doch: Ich verwende gerne den Befehl MsgBox Application.Path. In diesem Ordner befinden sich die Vorlagen und Schablonen von Visio (in Visio Content\1031).

Animationen in Visio?!?

Hallo Herr Martin,
ich hoffe, es geht Ihnen gut. Ich möchte mal wieder meine Visio Workflows verbessern. Würde mich mit einer besonderen Aufgabe in den nächsten Tagen bei Ihnen melden. Vorab eine Frage zu den Präsentationsmöglichkeiten mit Visio:
 
Angehängte Datei will ich wie eine Power Point Präsentation in einzelnen Stufen aufbauen lassen. Dafür habe ich alles Layern zugeordnet, die ich während der Präsentation nach und nach einblende. Ich lasse also immer das „Layer Properties“ Fenster auf und schalte nach und nach die Layer auf „Visible“ und bestätige mit „Apply“.
Ich würde das Ganze gerne im Vollbildmodus präsentieren, um so viel Bildschirmfläche wie möglich zu nutzen. Im Vollbildmodus kann ich aber nicht mehr das „Layer Properties“ Fenster öffnen. Haben Sie eine Idee, wie ich das lösen könnte? Makros bauen?
 
Ein Export zu Power Point ist mit meiner Visio 2010 Version nicht möglich, sondern nur mit Visio PLAN, wie ich gelesen habe?
 
Viele Grüße,
Hallo Herr W.,
 
lustige Frage! Die einzige Möglichkeit, um aus dem Präsentationsmodus ein Makro zu starten, ist eine Schaltfläche. Ich rufe nun das Makro „LayerAnzeigen“ auf, das einen Layer nach dem anderen anzeigt. Die Reihenfolge könnte man sicherlich noch ändern. Ebenso könnte man das zeitgesteuert aufrufen.
HIER unterbreche ich mit dem Meldungsfenster.
 
schöne Grüße
 
Rene Martin
PS: Der Code:
Dim i As Integer
For i = 1 To ActivePage.Layers.Count
ActivePage.Layers(i).CellsC(4).FormulaU = „=0“
Next
MsgBox „STOPP“
For i = 1 To ActivePage.Layers.Count
ActivePage.Layers(i).CellsC(4).FormulaU = „=1“
MsgBox „STOPP“
Next
Oder: Sie rufen den Layerdialog über eine Schaltfläche mit dem Befehl
Application.DoCmd 1448
auf

Ein eigener Nummerierungsassistent

Der Nummerierungsassistent ist fertig. Ich habe den Assistenten, der einige Bugs aufweist, nachgebaut. Man kann die Startnummer festlegen und die Schriftgröße ändern. Hierzu trägt man eine Zahl in den Dialog ein – alle Nummer werden nun größer oder kleiner. Die Technik:
der Dialog schreibt die Nummer in eine Zelle des ShapeSheets des Zeichenblattes:
ActivePage.PageSheet.Cells(„User.garSchriftgroesse“).FormulaU = „=“ & Me.txtSchrift.Value
Jede Nummer „holt“ sich diese Schriftgröße:
vsShapeNummernBobbel.Cells(„Char.Size“).FormulaU = „=GUARD(ThePage!User.garSchriftgroesse&““pt.““)“

Fläche berechnen

Hallo Herr M.,

[…] Jedes Shape in Visio hat eine x- und y-Position, die Width und Height kann ebenfalls über das ShapeSheet ausgelesen werden.

Um die Fläche zu berechnen, können Sie die Eigenschaft AreaIU der Shapes verwenden (Achtung: muss mit 2.54 ^ 2 multipliziert werden, da das Ergebnis Quadratinch ist).

MsgBox ActivePage.Shapes(1).AreaIU * 2.54 ^ 2

Damit können Sie leicht die Flächen berechnen.

schöne Grüße

Rene Martin

Eigene Shapes mit VBA erzeugen

Ich überarbeite gerade mein Visio-Programmierbuch. Ich bin beim Kapitel per Programmierung neue Shapes erzeugen, beispielsweise Rechtecke oder Kreise:
Soll auf dem Zeichenblatt ein Rechteck gezeichnet werden, ist dafür der Befehl DrawRectangle zuständig. Dabei sind vier Parameter anzugeben, die die Koordinaten von zwei gegenüberliegenden Eckpunkten bestimmen. Dabei wird von den Koordi-naten des Zeichenblatts ausgegangen (so sitzt der Ursprung in (0/0)). Die Werte selbst müssen in Zoll (Inch) angegeben werden. Das folgende Beispiel zeichnet ein Rechteck mit den Eckkoordinaten (1/1) und (3/2):
Sub Rechteck_Zeichnen()
ActivePage.DrawRectangle 1, 1, 3, 2
End Sub
Zum gleichen Ergebnis wäre man auch folgendermaßen gekommen:
ActivePage.DrawRectangle 1, 2, 3, 1
oder auch so:
ActivePage.DrawRectangle 3, 1, 1, 2
Wichtig sind dabei lediglich die beiden gegenüberliegenden Eckpunkte.
Analog wird eine Ellipse gezeichnet:
Sub Ellipse_Zeichnen01()
ActivePage.DrawOval 1, 1, 3, 2
End Sub
Wird mit dem neu gezeichneten Objekt weitergearbeitet, muss es an eine Objektva-riable übergeben werden:
Sub Ellipse_Zeichnen02()
Dim vsShape As Shape
Set vsShape = ActivePage.DrawOval(1, 1, 3, 2)
vsShape.Text = „Frohe Ostern“
End Sub
Dafür werde ich ein schönes Beispiel bringen. In einigen Programen, die ich an Kunden ausgeliefert habe, überprüfe ich die Voraussetzungen der Zeichnungen. Sollte etwas nicht stimmen, lege ich einen roten Punkt auf das nicht korrekte Shape.

Schräg stehende Shapes

Erinnern Sie sich an den Satz des Pythagoras? Heute habe ich ihn gebraucht. Eine Firma möchte, dass ich Informationen aus einer Visio-Datei herauslese. Es geht dabei um Raumpläne; es geht um die Frage, welche Bemaßungslinie befindet sich in der Nähe der Shapes. Bei waagrechten und senkrechten Anordnungen ist das kein Problem – aber bei schrägen? Nun – ein bisschen knobeln, Satz des Pythagoras – schon kann der Abstand von Pin zu Pin berechnet werden.
Eine Bemerkung an alle Eltern, die sich mit der Frage ihrer Kinder rumschlagen müssen: „Wozu muss ich denn das lernen?“ Ich habe mein gesamtes Schulwissen der Mathematik bis einschließlich Oberstufe irgendwann einmal bei einer Softwarelösung benötigt. So wie beispielsweise hier.

Blätter per VBA erzeugen?!

Hallo Herr Martin,
Ich habe mal „auf die Schnelle“ versucht Seiten per VBA von einem Quelldokument in das Zieldokument an die gewünschte Position zu kopieren. Bisher ohne Erfolg.
Gibt es da ein Script als Vorlage? Ich habe auch das Problem, das der „Fokus“ dann auch dem falschen Dokument liegt.
Kann man ein Dokument öffnen, so dass es für den Bediener nicht sichtbar ist.? Oder soll man für jede Seite, die man einfügt ein eigenes Dokument, bestehend aus nur dieser Seite erzeugen?
####
Hallo Herr H.,
 
in Excel ist das ein einfacher Befehl: Kopiere ein Tabellenblatt aus einer Datei in eine andere Datei. Das mache ich häufig.
In Visio geht das (wohl) nicht.
Sie finden im Kontextmenü der Zeichenblätter keinen Befehl „kopieren“.
Das Page-Objekt kennt zwar die Methode „Duplicacte“ (in die gleiche Datei), aber nicht „Copy“ (in eine andere Datei).
Es ist auch nicht möglich, einzelne Zeichnungsblätter auf verschiedenen Vorlagen basieren zu lassen – ich vermute, das ist der Grund, warum man keine Blätter kopieren kann.
Sie könnten alle Shapes kopieren – aber Achtung: ich fürchte Sie werden Schwierigkeiten bekommen. Ich habe (in einem älteren Projekt) mal versucht die Shapes zu gruppieren, das Gruppenshape zu kopieren und auf einem anderen Blatt zu entgruppieren – bin aber gescheitert, weil dann Verbinderereignisse eintreten, die mir die Verbinder anderes kleben wie ich es gerne hätte.
 
Meine Empfehlung: Finger weg vom „Blatt kopieren“!
 
Erzeugen Sie neue Blätter durch:
* Ein- und Ausblenden
* Herausziehen von bestimmten Master-Shapes aus Schablonen