Visio2002: Beispiel-Makro zum Duplizieren von Zeichenblättern

Dieser Artikel ist eine Übersetzung des folgenden englischsprachigen Artikels der Microsoft Knowledge Base:
290581 Visio2002: Sample Macro to Duplicate a Page
Artikel
289859 beschreibt dieses Thema für Microsoft Visio 2000.

Zusammenfassung

In diesem Artikel wir beschrieben, wie Sie ein Zeichenblatt mitsamt den enthaltenen Shapes mithilfe von Microsoft Visual Basic for Applications duplizieren können. Der Beispielcode illustriert zudem, wie Sie mithilfe der Eigenschaft Page.PageSheet auf die ShapeSheet-Zellen eines Zeichenblatts zugreifen können.

Weitere Informationen

Die Verwendung der hier aufgeführten Information, Makro- oder Programmcodes geschieht auf Ihre eigene Verantwortung. Microsoft stellt Ihnen diese Informationen sowie Makro- und Programmlistings ohne Gewähr auf Richtigkeit, Vollständigkeit und/oder Funktionalität sowie ohne Anspruch auf Support zur Verfügung. Die zur Verfügung gestellten Makro- und Programmierungsbeispiele sollen lediglich exemplarisch die Funktionsweise des Beispiels aufzeigen.

Beispielcode

Der folgende Beispielcode dupliziert ein Zeichenblatt:
Public Sub DuplicateActivePage()
Dim OriginalPage As Visio.Shape
Dim DuplicatePage As Visio.Shape

Dim ShapeDropX As Double
Dim ShapeDropY As Double

Set OriginalPage = ActivePage.PageSheet
ActiveWindow.SelectAll 'Select everything on the first page...
ActiveWindow.Group '...then group it all...
ActiveWindow.Copy '... then copy it to the clipboard.

ShapeDropX = ActiveWindow.Selection(1).Cells("PinX")
'Get the new Group's x position.

ShapeDropY = ActiveWindow.Selection(1).Cells("PinY")
'Get the new Group's y position.

Set DuplicatePage = ActiveDocument.Pages.Add.PageSheet
'Create the new page.

'Set attributes of the new page to be the same as the original page.
With DuplicatePage
.Cells("PageWidth") = OriginalPage.Cells("PageWidth")
.Cells("PageScale") = OriginalPage.Cells("PageScale")
.Cells("ShdwOffsetX") = OriginalPage.Cells("ShdwOffsetX")
.Cells("PageHeight") = OriginalPage.Cells("PageHeight")
.Cells("DrawingScale") = OriginalPage.Cells("DrawingScale")
.Cells("ShdwOffsetY") = OriginalPage.Cells("ShdwOffsetY")
.Cells("DrawingSizeType") = OriginalPage.Cells("DrawingSizeType")
.Cells("DrawingScaleType") = OriginalPage.Cells("DrawingScaleType")
.Cells("InhibitSnap") = OriginalPage.Cells("InhibitSnap")
.Cells("PlaceStyle") = OriginalPage.Cells("PlaceStyle")
.Cells("PlaceDepth") = OriginalPage.Cells("PlaceDepth")
.Cells("PlowCode") = OriginalPage.Cells("PlowCode")
.Cells("ResizePage") = OriginalPage.Cells("ResizePage")
.Cells("DynamicsOff") = OriginalPage.Cells("DynamicsOff")
.Cells("EnableGrid") = OriginalPage.Cells("EnableGrid")
.Cells("CtrlAsInput") = OriginalPage.Cells("CtrlAsInput")
.Cells("LineAdjustFrom") = OriginalPage.Cells("LineAdjustFrom")
.Cells("BlockSizeX") = OriginalPage.Cells("BlockSizeX")
.Cells("BlockSizeY") = OriginalPage.Cells("BlockSizeY")
.Cells("AvenueSizeX") = OriginalPage.Cells("AvenueSizeX")
.Cells("AvenueSizeY") = OriginalPage.Cells("AvenueSizeY")
.Cells("RouteStyle") = OriginalPage.Cells("RouteStyle")
.Cells("PageLineJumpDirX") = OriginalPage.Cells("PageLineJumpDirX")
.Cells("PageLineJumpDirY") = OriginalPage.Cells("PageLineJumpDirY")
.Cells("LineAdjustTo") = OriginalPage.Cells("LineAdjustTo")
.Cells("LineToNodeX") = OriginalPage.Cells("LineToNodeX")
.Cells("LineToNodeY") = OriginalPage.Cells("LineToNodeY")
.Cells("LineToLineX") = OriginalPage.Cells("LineToLineX")
.Cells("LineToLineY") = OriginalPage.Cells("LineToLineY")
.Cells("LineJumpFactorX") = OriginalPage.Cells("LineJumpFactorX")
.Cells("LineJumpFactorY") = OriginalPage.Cells("LineJumpFactorY")
.Cells("LineJumpCode") = OriginalPage.Cells("LineJumpCode")
.Cells("LineJumpStyle") = OriginalPage.Cells("LineJumpStyle")
.Cells("XRulerOrigin") = OriginalPage.Cells("XRulerOrigin")
.Cells("YRulerOrigin") = OriginalPage.Cells("YRulerOrigin")
.Cells("XRulerDensity") = OriginalPage.Cells("XRulerDensity")
.Cells("YRulerDensity") = OriginalPage.Cells("YRulerDensity")
.Cells("XGridOrigin") = OriginalPage.Cells("XGridOrigin")
.Cells("YGridOrigin") = OriginalPage.Cells("YGridOrigin")
.Cells("XGridDensity") = OriginalPage.Cells("XGridDensity")
.Cells("YGridDensity") = OriginalPage.Cells("YGridDensity")
.Cells("XGridSpacing") = OriginalPage.Cells("XGridSpacing")
.Cells("YGridSpacing") = OriginalPage.Cells("YGridSpacing")
End With

ActivePage.Paste 'Paste the copied group from the Clipboard.
ActiveWindow.Selection(1).Cells("PinX") = ShapeDropX
'Position the group.
ActiveWindow.Selection(1).Cells("PinY") = ShapeDropY
ActiveWindow.Selection(1).Ungroup 'Ungroup the group.

ActiveWindow.Page = OriginalPage.ContainingPage.Name
'Go back to the original page...

ActiveWindow.SelectAll '...then select the group...
ActiveWindow.Selection(1).Ungroup '...and ungroup it...
ActiveWindow.DeselectAll ' and then deselect all of the shapes.

MsgBox DuplicatePage.ContainingPage.Name & " has been created."
End Sub

Informationsquellen

Weitere Informationen über die Verwendung des Beispielcodes aus diesem Artikel finden Sie im folgenden Artikel der Microsoft Knowledge Base:
277011 Visio2000: How to Run Sample Code from Knowledge Base Articles
Oder besuchen Sie folgende Website von Microsoft:
Bitte beachten Sie: Bei diesem Artikel handelt es sich um eine Übersetzung aus dem Englischen. Es ist möglich, dass nachträgliche Änderungen bzw. Ergänzungen im englischen Originalartikel in dieser Übersetzung nicht berücksichtigt sind. Die in diesem Artikel enthaltenen Informationen basieren auf der/den englischsprachigen Produktversion(en). Die Richtigkeit dieser Informationen in Zusammenhang mit anderssprachigen Produktversionen wurde im Rahmen dieser Übersetzung nicht getestet. Microsoft stellt diese Informationen ohne Gewähr für Richtigkeit bzw. Funktionalität zur Verfügung und übernimmt auch keine Gewährleistung bezüglich der Vollständigkeit oder Richtigkeit der Übersetzung.
Eigenschaften

Artikelnummer: 290581 – Letzte Überarbeitung: 11.11.2005 – Revision: 1

Feedback