Langsames Visio?

Dear guys from Microsoft,
 
may I disturb you? maybe you could help me (a better: a friend and colleague – Wolfgang) with a Visio problem. Better: with two problems.
 
1st problem: Visio 2010. Wolfgang bought a Visio license in 2018 and used that program from that time on. He created VBA-routines, which were becoming slower and slower from day to day. Well – the code needs a lot of performance, but – becoming slower? … Unfortunately – his experience – also Visio 2013, 2016 and Visio in Microsoft 365 is not better.
 
If you want to have a closer look what he is doing – you find the ideas on:
 
https://www.transport-simulation.de/
 
We suppose, that the last Windows update, which took place on June, 8th 2020 – number of the version: 14.0.7015.1000, on the main computer produced that problem, because on a laptop (without this update), Visio works much more faster. Unfortunately this version on the main computer is irreversible …
 
Do you have idea how to deactivate this version, how to reset …?
 
2nd problem: On another computer Visio 2010 cannot be started – same key, same build, completely locked with the alert: “Invalid product key – please activate Office” (of course: in German)
 
Do you have any idea? Could you please help Wolfgang.
 
And certainly – you can address directly to
 
thanks
 
regards from Munich
 
René

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.