Yes, you can add new shapes. But there is few questions:
1. which shapes you want add to page ?
2. where you want placed this inserted shapes ?
it is the code that I found :
Me.Application.Documents.Add("") Dim visioDocs As Visio.Documents = Me.Application.Documents Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked)) Dim visioPage As Visio.Page = Me.Application.ActivePage Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle") Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5) visioRectShape.Text = "Rectangle text." Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7") Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5) visioStarShape.Text = "Star text." Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon") Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5) visioHexagonShape.Text = "Hexagon text."
- Edited by Victor Solorzano Tuesday, November 25, 2014 3:16 PM
it is the code that I found :
Me.Application.Documents.Add("") Dim visioDocs As Visio.Documents = Me.Application.Documents Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked)) Dim visioPage As Visio.Page = Me.Application.ActivePage Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle") Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5) visioRectShape.Text = "Rectangle text." Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7") Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5) visioStarShape.Text = "Star text." Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon") Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5) visioHexagonShape.Text = "Hexagon text."
- Edited by Victor Solorzano Tuesday, November 25, 2014 3:16 PM
it is the code that I found :
Me.Application.Documents.Add("") Dim visioDocs As Visio.Documents = Me.Application.Documents Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked)) Dim visioPage As Visio.Page = Me.Application.ActivePage Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle") Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5) visioRectShape.Text = "Rectangle text." Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7") Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5) visioStarShape.Text = "Star text." Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon") Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5) visioHexagonShape.Text = "Hexagon text."
- Edited by Victor Solorzano Tuesday, November 25, 2014 3:16 PM
it isn't VBA code, it is VB.Net! this code open vss stencil Basic Shapes.vss, drop some shapes and set text in these shapes :)
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
it isn't VBA code, it is VB.Net! this code open vss stencil Basic Shapes.vss, drop some shapes and set text in these shapes :)
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
it isn't VBA code, it is VB.Net! this code open vss stencil Basic Shapes.vss, drop some shapes and set text in these shapes :)
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
Dim visioPage As Visio.Page = Me.Application.ActivePage
you add all shapes to ActivePage
Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", _
CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
there you open external vss-file (aka stencil) which contain some shapes. and these shapes from this stencil your code droped to ActivePage
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
- Marked as answer by Victor Solorzano Tuesday, November 25, 2014 8:38 PM
Dim visioPage As Visio.Page = Me.Application.ActivePage
you add all shapes to ActivePage
Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", _
CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
there you open external vss-file (aka stencil) which contain some shapes. and these shapes from this stencil your code droped to ActivePage
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
- Marked as answer by Victor Solorzano Tuesday, November 25, 2014 8:38 PM
Dim visioPage As Visio.Page = Me.Application.ActivePage
you add all shapes to ActivePage
Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", _
CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
there you open external vss-file (aka stencil) which contain some shapes. and these shapes from this stencil your code droped to ActivePage
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:26 PM
- Marked as answer by Victor Solorzano Tuesday, November 25, 2014 8:38 PM
look at my OneDrive for example
1. Select some shape
2. Press hotkey Ctrl+Shift+S
3. Click on Left Mouse Button in desired place on ActivePage
4. Repeate action 3 some times
5. If you need break this action press Esc
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:25 PM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM
look at my OneDrive for example
1. Select some shape
2. Press hotkey Ctrl+Shift+S
3. Click on Left Mouse Button in desired place on ActivePage
4. Repeate action 3 some times
5. If you need break this action press Esc
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:25 PM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM
look at my OneDrive for example
1. Select some shape
2. Press hotkey Ctrl+Shift+S
3. Click on Left Mouse Button in desired place on ActivePage
4. Repeate action 3 some times
5. If you need break this action press Esc
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:25 PM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM
my example contained this code
Dim WithEvents myapp As Visio.Application
Dim x As Double, y As Double
'
Sub Start()
Set myapp = Application
End Sub
'
Private Sub myapp_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x1 As Double, ByVal y1 As Double, CancelDefault As Boolean)
If Button = 1 Then ' м
x = x1: y = y1
End If
End Sub
' м
Private Sub myapp_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x2 As Double, ByVal y2 As Double, CancelDefault As Boolean)
Dim Fshp As Shape
If ActiveWindow.Selection.Count = 0 Then End
Set Fshp = ActiveWindow.Selection(1)
Fshp.Copy
ActivePage.PasteToLocation x, y, visPasteVisioShapes
End Sub
or you need translate your code from .NET to VBA?
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:36 PM
my example contained this code
Dim WithEvents myapp As Visio.Application
Dim x As Double, y As Double
'
Sub Start()
Set myapp = Application
End Sub
'
Private Sub myapp_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x1 As Double, ByVal y1 As Double, CancelDefault As Boolean)
If Button = 1 Then ' м
x = x1: y = y1
End If
End Sub
' м
Private Sub myapp_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x2 As Double, ByVal y2 As Double, CancelDefault As Boolean)
Dim Fshp As Shape
If ActiveWindow.Selection.Count = 0 Then End
Set Fshp = ActiveWindow.Selection(1)
Fshp.Copy
ActivePage.PasteToLocation x, y, visPasteVisioShapes
End Sub
or you need translate your code from .NET to VBA?
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:36 PM
my example contained this code
Dim WithEvents myapp As Visio.Application
Dim x As Double, y As Double
'
Sub Start()
Set myapp = Application
End Sub
'
Private Sub myapp_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x1 As Double, ByVal y1 As Double, CancelDefault As Boolean)
If Button = 1 Then ' м
x = x1: y = y1
End If
End Sub
' м
Private Sub myapp_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x2 As Double, ByVal y2 As Double, CancelDefault As Boolean)
Dim Fshp As Shape
If ActiveWindow.Selection.Count = 0 Then End
Set Fshp = ActiveWindow.Selection(1)
Fshp.Copy
ActivePage.PasteToLocation x, y, visPasteVisioShapes
End Sub
or you need translate your code from .NET to VBA?
(Please take a moment to "Vote as Helpful" and/or "Mark as Answer", where applicable.
This helps the community, keeps the forums tidy, and recognises useful contributions. Thanks!)
- Edited by Surrogate Tuesday, November 25, 2014 7:36 PM
'Me.Application.Documents.Add ("")
Application.Documents.Add ("")
'Dim visioDocs As Visio.Documents = Me.Application.Documents
Dim visioDocs As Visio.Documents
Set visioDocs = Application.Documents
'Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
Dim visioStencil As Visio.Document
Set visioStencil = visioDocs.OpenEx("Basic Shapes.vss", visOpenDocked)
'Dim visioPage As Visio.Page = Me.Application.ActivePage
Dim visioPage As Visio.Page
Set visioPage = Application.ActivePage
'Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle")
Dim visioRectMaster As Visio.Master
Set visioRectMaster = visioStencil.Masters("Rectangle")
'Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
Dim visioRectShape As Visio.Shape
Set visioRectShape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
visioRectShape.Text = "Rectangle text."
'Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7")
Dim visioStarMaster As Visio.Master
Set visioStarMaster = visioStencil.Masters("Star 7")
'Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5)
Dim visioStarShape As Visio.Shape
Set visioStarShape = visioPage.Drop(visioStarMaster, 2#, 5.5)
visioStarShape.Text = "Star text."
'Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon")
Dim visioHexagonMaster As Visio.Master
Set visioHexagonMaster = visioStencil.Masters("Hexagon")
'Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5)
Dim visioHexagonShape As Visio.Shape
Set visioHexagonShape = visioPage.Drop(visioHexagonMaster, 7#, 5.5)
visioHexagonShape.Text = "Hexagon text."
- Edited by Surrogate Wednesday, November 26, 2014 3:44 AM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM
'Me.Application.Documents.Add ("")
Application.Documents.Add ("")
'Dim visioDocs As Visio.Documents = Me.Application.Documents
Dim visioDocs As Visio.Documents
Set visioDocs = Application.Documents
'Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
Dim visioStencil As Visio.Document
Set visioStencil = visioDocs.OpenEx("Basic Shapes.vss", visOpenDocked)
'Dim visioPage As Visio.Page = Me.Application.ActivePage
Dim visioPage As Visio.Page
Set visioPage = Application.ActivePage
'Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle")
Dim visioRectMaster As Visio.Master
Set visioRectMaster = visioStencil.Masters("Rectangle")
'Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
Dim visioRectShape As Visio.Shape
Set visioRectShape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
visioRectShape.Text = "Rectangle text."
'Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7")
Dim visioStarMaster As Visio.Master
Set visioStarMaster = visioStencil.Masters("Star 7")
'Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5)
Dim visioStarShape As Visio.Shape
Set visioStarShape = visioPage.Drop(visioStarMaster, 2#, 5.5)
visioStarShape.Text = "Star text."
'Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon")
Dim visioHexagonMaster As Visio.Master
Set visioHexagonMaster = visioStencil.Masters("Hexagon")
'Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5)
Dim visioHexagonShape As Visio.Shape
Set visioHexagonShape = visioPage.Drop(visioHexagonMaster, 7#, 5.5)
visioHexagonShape.Text = "Hexagon text."
- Edited by Surrogate Wednesday, November 26, 2014 3:44 AM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM
'Me.Application.Documents.Add ("")
Application.Documents.Add ("")
'Dim visioDocs As Visio.Documents = Me.Application.Documents
Dim visioDocs As Visio.Documents
Set visioDocs = Application.Documents
'Dim visioStencil As Visio.Document = visioDocs.OpenEx("Basic Shapes.vss", CShort(Microsoft.Office.Interop.Visio.VisOpenSaveArgs.visOpenDocked))
Dim visioStencil As Visio.Document
Set visioStencil = visioDocs.OpenEx("Basic Shapes.vss", visOpenDocked)
'Dim visioPage As Visio.Page = Me.Application.ActivePage
Dim visioPage As Visio.Page
Set visioPage = Application.ActivePage
'Dim visioRectMaster As Visio.Master = visioStencil.Masters("Rectangle")
Dim visioRectMaster As Visio.Master
Set visioRectMaster = visioStencil.Masters("Rectangle")
'Dim visioRectShape As Visio.Shape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
Dim visioRectShape As Visio.Shape
Set visioRectShape = visioPage.Drop(visioRectMaster, 4.25, 5.5)
visioRectShape.Text = "Rectangle text."
'Dim visioStarMaster As Visio.Master = visioStencil.Masters("Star 7")
Dim visioStarMaster As Visio.Master
Set visioStarMaster = visioStencil.Masters("Star 7")
'Dim visioStarShape As Visio.Shape = visioPage.Drop(visioStarMaster, 2.0, 5.5)
Dim visioStarShape As Visio.Shape
Set visioStarShape = visioPage.Drop(visioStarMaster, 2#, 5.5)
visioStarShape.Text = "Star text."
'Dim visioHexagonMaster As Visio.Master = visioStencil.Masters("Hexagon")
Dim visioHexagonMaster As Visio.Master
Set visioHexagonMaster = visioStencil.Masters("Hexagon")
'Dim visioHexagonShape As Visio.Shape = visioPage.Drop(visioHexagonMaster, 7.0, 5.5)
Dim visioHexagonShape As Visio.Shape
Set visioHexagonShape = visioPage.Drop(visioHexagonMaster, 7#, 5.5)
visioHexagonShape.Text = "Hexagon text."
- Edited by Surrogate Wednesday, November 26, 2014 3:44 AM
- Marked as answer by George.Zhao CHNMicrosoft contingent staff, Moderator Monday, December 08, 2014 1:12 AM


