Autor: Rene_Martin

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“)

Auf Daten einer externen Datenquelle zugreifen

Schritt III
An eine Visio-Zeichnung werden Daten einer Exceltabelle gebunden. Diese sollen dem Anwender zur Auswahl stehen. Über eine Userform kann der Anwender auswählen.
Beim Öffnen wird auf die Datenquelle zugegriffen und alle Spalten angezeigt:
Me.Controls(„ComboBox“ & i).AddItem „Keine Auswahl“
Me.Controls(„ComboBox“ & (i + 12)).AddItem „Keine Auswahl“
For j = 1 To ActiveDocument.DataRecordsets(1).DataColumns.Count
Me.Controls(„ComboBox“ & i).AddItem ActiveDocument.DataRecordsets(1).DataColumns(j).Name
Me.Controls(„ComboBox“ & (i + 12)).AddItem ActiveDocument.DataRecordsets(1).DataColumns(j).Name
Next j
Ich gehe davon aus, dass es nur eine Datenquelle gibt.

Racks zusammenfassen – Schritt 2

Schritt II
Die Racks sollen Namen haben. Diese Namen sollen im Report aufgelistet werden. Und der Name soll als Beschriftung angezeigt werden. Dafür gibt es zwei Lösungen:
* Man kann die Namen über die Daten eingeben.
* Man kann die Namen über Entwicklertools / Shape-Name festlegen.
Ich habe mich für letztere Variante entschieden.
Da das Shape eine Gruppe ist, gibt nun auch wieder zwei Varianten, wie man den Namen anzeigen lassen kann:
* In einem Mitgliedsshape mit einer Verknüpfung auf das Gruppenshape, also:
= Sheet.4711!Prop.Rackname
oder:
= Sheet.4711!NAME()
Und diese Information – gespeichert in einer benutzerdefinierten Zelle oder in einem Daten Feld kann über Einfügen / Feld als Text eingefügt werden.
Auch hier habe ich mich für die zweite Variante entschieden:
* direkt auf der Gruppe habe ich den Text editiert ([F2]) und dann über Einfügen / Feld / Objektinfo / Name eingefügt. Mit dem Werkzeug „Textblock“ kann man ihn verschieben.
Und über Entwicklertools / Schutz habe ich den Text der Gruppe geschützt. Alternativ: im ShapeSheet.

Rackdaten zusammenfassen – Schritt 1

Die Aufgabe: An eine Visio-Zeichnung sind Daten gebunden. Von diesen Daten werden einige Datensätze verwendet und sollen in der Zeichnung gruppiert und summiert angezeigt werden. Ebenso sollen diese Informationen nach Excel exportiert werden.
Und so habe ich es gemacht: Schritt I: Die Shapes vorbereiten.
Damit die Shapes (hier: die Schränke, die Racks) „eingesammelt“ werden können, müssen sie gekennzeichnet werden. Da ihnen kein Master zugrunde liegt, werden sie auf Layer gelegt. So können sie später am leichtesten „identifiziet“ werden:
For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).LayerCount > 0 Then
If ActivePage.Shapes(i).Layer(1).Name = „Rack“ Then