Hallo Herr Dr. Martin,
ich hätte nochmal ein paar spezielle Fragen zu Visio.
Ich kann über VBA auf die Shape-Daten meiner Shapes auf dem Zeichenblatt zugreifen … ABER … Wie kann ich auf Shape-Daten von Schablonen über VBA zugreifen?
Und: Gibt es eine Möglichkeit die Shape-Daten eines Shapes auf einen Schlag komplett zu löschen?
Z.Zt. kann ich immer nur die einzelnen Elemente löschen aber nicht alle auf einmal.
###
Hallo Herr S.,
* Sie müssen auf alle offenen Dokumente in Visio zugreifen, überprüfen, ob es sich dabei um eine Schablone handelt, die Mastershapes auslesen und von ihnen die Daten auslesen.
*ich würde nicht auf die Shape-Datensätze zugreifen. Erstes weiß ich nicht, wo Visio diese abspeichert, zweites ist es mir zu unsicher und drittens vermute ich einen Bug darin (das an anderer Stelle). Ich würde auf Abschnitt und Zeilen der Shapes per Schleife zugreifen.
* Sie können den Abschnitt visSectionProp löschen – aber dann zickt er manchmal – oder besser: jede Zeile dieses Abschnittes.
Beispielsweise so:
Public Sub cmdDaten1(ByRef control As IRibbonControl)
Dim strDateien As String
Dim strSchablonen As String
Dim vsSchablone() As Document
Dim strMaster() As String
Dim vsMastershape As Master
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim strSpapeDatenzeile As String
ReDim vsSchablone(0)
For i = 1 To Application.Documents.Count
‚ — durchlaufe alle offenen Dokumente
strDateien = strDateien & Application.Documents(i).Name & vbCr
If Application.Documents(i).Type = visTypeStencil Then
‚ — wenn du eine Schablone bist
ReDim Preserve vsSchablone(UBound(vsSchablone) + 1)
strSchablonen = strSchablonen & Application.Documents(i).Name & vbCr
Set vsSchablone(UBound(vsSchablone)) = Application.Documents(i)
End If
Next i
MsgBox „Liste der offenen Dateien:“ & vbCr & strDateien
MsgBox „Liste der offenen Schablonen:“ & vbCr & strSchablonen
For j = 1 To UBound(vsSchablone)
vsSchablone(j).Masters.GetNames strMaster
‚ — alle Mastershapes der Schablone
MsgBox „Liste der Mastershapes der Schablone “ & vsSchablone(j) & vbCr & Join(strMaster, vbCr)
For k = 0 To UBound(strMaster)
Set vsMastershape = Application.Documents(vsSchablone(j).Name).Masters(strMaster(k))
strSpapeDatenzeile = „“
If vsMastershape.Shapes(1).SectionExists(visSectionProp, False) = True Then
‚ — wenn Shapedaten im Mastershape vorhanden sind.
For m = 0 To vsMastershape.Shapes(1).Section(visSectionProp).Count – 1
strSpapeDatenzeile = strSpapeDatenzeile & vsMastershape.Shapes(1).Section(visSectionProp).Row(m).Cell(0).Name & vbCr
‚###############
‚ Cell(0): Value
‚ Cell(1): Prompt
‚ Cell(2): Label
‚ Cell(3): Format
‚ Cell(4): SortKey
‚ Cell(5): Type
‚ Cell(6): Invisible
‚ Cell(7): Verify
‚ Cell(8): DateLinked
‚###############
Next
MsgBox „Mastershape „““ & vsMastershape.Name & „““ hat folgende Daten:“ & vbCr & strSpapeDatenzeile
End If
Next
Next
End Sub
Public Sub cmdDaten3(ByRef control As IRibbonControl)
Dim i As Integer
If ActiveWindow.Selection.Count = 0 Then
MsgBox „Sie haben kein Shape ausgewählt!“
ElseIf ActiveWindow.Selection.Count > 1 Then
MsgBox „Bitte markieren Sie nur ein Shape!“
Else
For i = ActiveWindow.Selection(1).Section(visSectionProp).Count – 1 To 0 Step -1
ActiveWindow.Selection(1).DeleteRow visSectionProp, i
Next
MsgBox „Alle Zeilen der Shape-Daten wurden gelöscht!“
End If
End Sub
Public Sub cmdDaten2(ByRef control As IRibbonControl)
If ActiveWindow.Selection.Count = 0 Then
MsgBox „Sie haben kein Shape ausgewählt!“
ElseIf ActiveWindow.Selection.Count > 1 Then
MsgBox „Bitte markieren Sie nur ein Shape!“
Else
If ActiveWindow.Selection(1).SectionExists(visSectionProp, False) = True Then
ActiveWindow.Selection(1).DeleteSection visSectionProp
MsgBox „Abschnitt „“Shape-Daten““ wurde gelöscht!“
End If
End If
End Sub
