Kategorie: Visio anpassen

Shapes konvertieren

Ein Konvertierprojekt – Teil V
Mit Hilfe des Shapes LCD-Monitor habe ich das neue Shape erstellt. Etwas irritiert und erstaunt bin ich, weil das Quickinfo als Name meldet:
LCD-Monitor
Ein Blicks ins ShapeSheet – in die Zelle Comment des Abschnitts „Miscellaneous“ gibt Auskunft. Dort findet sich die Formel:
=INDEX(0,INDEX(0,MASTERNAME(),“:“),“.“)
Das Heißt: der Name des Mastershapes wird angezeigt. Sollte durch Veränderung das Mastershape nicht
LCD-Monitor
sondern
LCD-Monitor.42
wird der Text vor dem Punkt herausgelöst.
Also: Shape in eine Schablone ziehen, umbenennen und das Mastershape aus der Schablone auf das Zeichenblatt zurückziehen – fertig!
Eine clevere Formel aus dem Hause Visio!

Feste Textposition auf Pfeilen

Hallo Rene,
nun bräuchte ich nochmal Visio Unterstützung:
 
1. In angehängter Datei habe ich Verbindungslinien mit Text versehen. Per Shape Sheet habe ich die Texte fixiert.
a. Ich möchte dass die linkbündigen immer einen Abstand von 5 mm zum Startpunkt haben, die rechtsbündigen denselben Abstand zum Endpunkt
b. Die Höhe bei beiden soll auch fix sein
c. Wenn ich die Verbinder länger-, kürzer- oder um Ecken ziehe soll die Position sich nicht verändern
d. auf der rechten Seite des Blocks ist mir das mit den linksbündigen Verbinder gelungen. Auf der linken Seite aber nicht. Sobald Du daran ziehst ändern sich die Positionen
###
Hallo Gunnar,
 
bei den „rechten“ Verbindern ist das kein Problem – hier muss die Position absolut als Zahl gesetzt werden.
 
bei den linken Verbindern, die nach rechts zeigen muss ich vom Ende ausgehen. Das heißt:
ich setze die Textwidth auf eine feste zahl, bspw. 80 mm. Den local Pin setze ich auch auf die rechte Seite, also:
TxtLocPinX: 80mm
Den TxtPinX rechne ich vom rechten Ende weg, also:
EndX
Da der Verbinder nicht durch zwei x- und zwei y-Punkte definiert ist, sondern eigentlich durch ein umschriebenes Rechteck (Box) mit einem Pin mit x- und y-Koordinaten, benötige ich hier auch den Anfangspunkt, also:
=GUARD(EndX-BeginX-5 mm)
Das GUARD ist nötig, weil Visio sonst die Formel überschreibt.
Die Konstante muss/kann man ausprobieren.
Allerdings: ich habe keine Ahnung, warum Visio bei BeginY = EndY anders rechnet. Ich habe es mit einem IF abgefangen. Nicht perfekt … Vielleicht hängt der Rechenfehler mit der Rundung der Linie zusammen?
TxtPinX: =GUARD(EndX-BeginX-5 mm)
TxtPinY: =GUARD(IF(BeginY=EndY,2.4 mm,IF(BeginY<EndY,2*(EndY-BeginY)-ABS(EndY-BeginY),EndY-BeginY))+3.5 mm)
Anbei die Lösung … Hübsche Knobelaufgabe!

Großbuchstaben

Hallo Rene,
Gibt es eine Möglichkeit den Text im Feld DESCRIPTION oder TITLE (da steht jetzt „Tankstelle“) immer in Großbuchstaben anzuzeigen, auch wenn die Shape Data klein geschrieben sind?
####
Mit UPPER kann man Buchstaben in Großbuchstaben konvertieren

Daten nach Excel mit VBA exportieren

Schritt X
Die Hauptschwierigkeit ist sicherlich das Einsammeln der Daten. Man kann sie in Excel in Shapes auflisten (als Text, wie beschrieben). Oder nach Excel oder eine Datenbank schreiben. Der Kunde wollte Excel:
Set xlApp = CreateObject(„Excel.Application“)
xlApp.Visible = False
Set xlDatei = xlApp.Workbooks.Add
Set xlBlatt = xlDatei.WorkSheets(1)
[…]
For i = 0 To intAnzahlDaten
xlBlatt.Cells(1, i + 1).Value = Split(strUeberschrift, „|“)(i)
Next
‚ — Überschrift
For i = 0 To intGruppe1 – 1
xlBlatt.Cells(1, intAnzahlDaten + i + 1).Value = ActivePage.PageSheet.Cells(„User.TextBox“ & (28 + i)).ResultStrU(„“)
Next i
For i = 0 To intGruppe2 – 1
xlBlatt.Cells(1, intAnzahlDaten + intGruppe1 + i + 1).Value = ActivePage.PageSheet.Cells(„User.TextBox“ & (32 + i)).ResultStrU(„“)
Next i
For i = 0 To intGruppe3 – 1
xlBlatt.Cells(1, intAnzahlDaten + intGruppe1 + intGruppe2 + i + 1).Value = ActivePage.PageSheet.Cells(„User.TextBox“ & (36 + i)).ResultStrU(„“)
Next i
Klappt!

Keine Fotobeschreibung verfügbar.

Shapes löschen

Schritt IX
möglicherweise müssen die neu erzeugten Shapes wieder gelöscht werden. Also muss man sie „kennzeichnen“. Dafür gibt es eine Reihe verschiedener Möglichkeiten:
* Layer
* Daten
* benutzerdefinierte Zellen.
Ich entscheide mich für Letztes. Beim Erzeugen erhalten die neuen Shapes eine benutzerdefinierte Zelle:
With vsShape
.AddSection visSectionUser
.AddRow visSectionUser, visRowFirst, 0
.Section(visSectionUser).Row(0).Name = „Windelband“


Beim Löschen wird überprüft, ob diese Zelle vorhanden ist. Wenn ja, wird das Shape gelöscht:
Sub AlleInfosLoeschen()
Dim i As Long
For i = ActivePage.Shapes.Count To 1 Step -1
If ActivePage.Shapes(i).CellExists(„User.Windelband“, False) = True Then
ActivePage.Shapes(i).Delete
End If
Next
End Sub

Shapes beschriften und formatieren

Schritt VIII
Und wie beschriftet man die neue erzeugten Rechtecke? Diese Aufgabe ist einfach – hierfür steht die Eigenschaft Text des Shapes zur Verfügung.
Und wie formatiert man es? Indem die entsprechenden Zellen des ShapeSheets mit den entsprechenden Werten gefüllt werden.
Tipp: Wenn Sie nicht wissen, welche Zelle für welches Schriftattribut zuständig ist, öffnen Sie das ShapeSheet, ändern in Visio die Formatierung und suchen im ShapeSheet den Zellwert, der nun nicht mehr schwarz, sondern blau ist.
Und das kann man so programmieren. Beispielsweise in einer ausgelagerten Prozedur:
Private Sub ShapeEinrichten(vsShape As Shape, Text As String, Optional Fett As String)
With vsShape
.AddSection visSectionUser
.AddRow visSectionUser, visRowFirst, 0
.Section(visSectionUser).Row(0).Name = „Windelband“
.Text = Text ‚ — Text
.Cells(„Para.HorzAlign“).FormulaU = „=1“ ‚ — zentriert
.Cells(„Char.Size“).FormulaU = „=“ & ActivePage.PageSheet.Cells(„User.Schriftgroesse“).ResultInt(„“, 0) & “ pt“ ‚ — Schriftgrad
If Fett = „fett“ Then
.Cells(„Char.Style“).FormulaU = „=17“ ‚ — fett
End If
.Cells(„LockMoveX“).FormulaU = „=1“ ‚ — sperren
.Cells(„LockMoveY“).FormulaU = „=1“ ‚ — sperren
End With
End Sub

Kästchen zeichnen

Schritt VII
Die äußeren Racks sind „eingesammelt“, die inneren „Geräte“ ebenso. Mit „eingesammelt“ meine ich die Daten, die in Variablen und Datenfeldern gespeichert wurden. Nun sollen diese Daten unterhalb der Racks ausgegeben werden. Dazu werden Rechtecke erzeugt (DrawRectangle), die unterhalb der Shapes platziert werden:
Die Breite des Racks wird berechnet:
dblBreite = Abs(Application.ConvertResult(dblRechteKante(i), „mm“, „in“) – Application.ConvertResult(dblLinkeKante(i), „mm“, „in“))
Die Funktion ConvertResult hilft Inch in Millimeter umzurechnen. Diese Breite wird durch die Anzahl der Kästchen geteilt:
dblBreite = dblBreite / intAnzahlDaten
Und anschließend die Kästchen „gezeichnet“:
Set vsShapeOben = ActivePage.DrawRectangle(Application.ConvertResult(dblLinkeKante(i), „mm“, „in“) + dblBreite * (j – 0), _
Application.ConvertResult(dblUntereKante(i), „mm“, „in“), _
Application.ConvertResult(dblLinkeKante(i), „mm“, „in“) + dblBreite * (j + 1), _
Application.ConvertResult(dblUntereKante(i) – 40, „mm“, „in“))
Erläuterung: Die Methode DrawRectangle verlangt die vier Koordinaten x1, y1, x2 und y2.

Shape innerhalb einen anderen Shapes

Schritt VI
Im zweiten Schritt werden alle Shapes eingesammelt. Es wird überprüft, ob es sich dabei um ein Teil innerhalb eines Racks handelt:
For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).CellExists(„Prop._VisDM_ID“, False) = True Then
Wenn ja, dann wird das zugehörige Rack gesucht:
intTemp = WelchesRack(ActivePage.Shapes(i))
Die Funktion WelchesRack überprüft, ob sich der Pin innerhalb des anderen Shapes befindet:
For i = 1 To UBound(strSchrank)
If vsShape.Cells(„PinX“).Result(„mm“) >= dblLinkeKante(i) And _
vsShape.Cells(„PinX“).Result(„mm“) <= dblRechteKante(i) And _
vsShape.Cells(„PinY“).Result(„mm“) <= dblObereKante(i) And _
vsShape.Cells(„PinY“).Result(„mm“) >= dblUntereKante(i) Then
intRack = i
Exit For
End If
Next
Zugegeben: ich hätte auch mit SpatialRelation arbeiten können:
intSpatialRelation = vsShape.SpatialRelation(vsRack, dblTolerance, visSpatialUprightWH)

Shapes „einsammeln“

Schritt V:
Der erste Teil der Aufgabe lautet: sammle alle Racks ein.
Nun – hierzu muss man die Racks identifizieren. Dies könnte über den Namen des Mastershapes geschehen, über die Größe, über die Kennzeichnung durch Daten oder benutzerdefinierte Zellen. Ich habe mich für „Layer“ entschieden. alle Racks liegen auf dem Layer Rack.
Die kann überprüft werden.


Alle Shapes, die auf einem solchen Layer liegen werden „namentlich“ eingesammelt:

For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).LayerCount > 0 Then
If ActivePage.Shapes(i).Layer(1).Name = „Rack“ Then

ReDim Preserve strSchrank(UBound(strSchrank) + 1)

strSchrank(UBound(strSchrank)) = ActivePage.Shapes(i).Name

End If
End If
Next

Informationen „merken“

Schritt IV
Informationen merken.
Das Angenehme an Visio ist, dass man sich „leicht“ Informationen merken kann – man kann sie an das Shape, an das Zeichenblatt oder an die Datei binden. Entweder an Daten (die auch vom Anwender geändert werden können) oder in benutzerdefinierten Zellen. Ich entschließe mich die im Dialog eingetragenen Informationen in benutzerdefinierten Zellen des Zeichenblatts einzutragen. Hierzu überprüfe ich im ersten Schritt, ob ein Abschnitt userdefined cells vorhanden ist. Falls nicht, wird er erzeugt.
 
If ActivePage.PageSheet.SectionExists(visSectionUser, False) = False Then
ActivePage.PageSheet.AddSection visSectionUser
End If
‚ — stelle sicher, dass visSectionUser existiert
 
Dann überprüfe ich, ob die benötigten Zellen vorhanden
sind:
 
For i = 1 To 12
If ActivePage.PageSheet.CellExists(„User.ComboBox“ & i, False) = False Then
 
Falls nicht, werden die Zellen erzeugt, benannt und mit dem Leerstring „“ vorbelegt:
 
ActivePage.PageSheet.AddRow visSectionUser, visRowLast, 0
ActivePage.PageSheet.Section(visSectionUser).Row(ActivePage.PageSheet.Section(visSectionUser).Count – 1).Name = „ComboBox“ & i
ActivePage.PageSheet.Cells(„User.ComboBox“ & i).FormulaU = „=“““““
End If
 
Auch für einzelne Werte (Schriftgroesse und Zusammenfassen wird das durchgeführt:
 
If ActivePage.PageSheet.CellExists(„User.Schriftgroesse“, False) = False Then
ActivePage.PageSheet.AddRow visSectionUser, visRowLast, 0
ActivePage.PageSheet.Section(visSectionUser).Row(ActivePage.PageSheet.Section(visSectionUser).Count – 1).Name = „Schriftgroesse“
ActivePage.PageSheet.Cells(„User.Schriftgroesse“).FormulaU = „=““10″““
End If
‚ Schriftgroesse
If ActivePage.PageSheet.CellExists(„User.Zusammenfassen“, False) = False Then
ActivePage.PageSheet.AddRow visSectionUser, visRowLast, 0
ActivePage.PageSheet.Section(visSectionUser).Row(ActivePage.PageSheet.Section(visSectionUser).Count – 1).Name = „Zusammenfassen“
ActivePage.PageSheet.Cells(„User.Zusammenfassen“).FormulaU = „=True“
End If
‚ — Zusammenfassen
Wenn sichergestellt ist, dass diese Zellen vorhanden sind, können sie gefüllt (und ausgelesen) werden:
Das Auslesen beim Start der Userform:
 
Me.txtSchriftgroesse.Value = ActivePage.PageSheet.Cells(„User.Schriftgroesse“).ResultInt(„“, 0)
Me.chkZusammenfassen.Value = ActivePage.PageSheet.Cells(„User.Zusammenfassen“).ResultInt(„“, 0)
 
Das Füllen bei „OK“:
ActivePage.PageSheet.Cells(„User.Schriftgroesse“).FormulaU = „=“““ & Me.txtSchriftgroesse.Value & „“““
ActivePage.PageSheet.Cells(„User.Zusammenfassen“).FormulaU = „=“ & IIf(Me.chkZusammenfassen.Value = True, „True“, „False“)