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