VBA Code to create a shape does not work as expected

[VisDom]

Hi all, I am trying to put a simple text on a page with VBA like this and it draws a rectangle with my text. But what ever values I put in to the DrawRectangle field, it is always created on the same space.

Code Select Expand


   Dim vsoShape1 As Visio.Shape
   Set vsoShape1 = ActivePage.DrawRectangle(0, 0, 0, 0)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"


Code Select Expand


   Set vsoShape1 = ActivePage.DrawRectangle(2,2 , 20, 20)



VisDom

[Surrogate]

what you mean as "same space" ?

[VisDom]

sorry typo: "same place"

[Surrogate]

Code Select Expand

Sub bb()
    Dim vsoShape1 As Visio.Shape
    Set vsoShape1 = ActivePage.DrawRectangle(0, 0, 0, 0)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
    Set vsoShape1 = ActivePage.DrawRectangle(2, 2, 4, 4)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
End Sub
On my side i see this behaviour after run that code

whats wrong ?

[VisDom]

Oh how embaracing. I had a longer SUB and at the end of it I have always set the LocPin. I just didnt notice.

Sorry

Code Select Expand


vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0"
vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0"


- How do you create those videos?

[Surrogate]

code changed LocPin position

Code Select Expand

Sub bb1()
    Dim vsoShape1 As Visio.Shape
    Set vsoShape1 = ActivePage.DrawRectangle(0, 0, 0, 0)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0"
' =====
    Set vsoShape1 = ActivePage.DrawRectangle(2, 2, 4, 4)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0"
End Sub



code changed Pin position

Code Select Expand

Sub bb2()
    Dim vsoShape1 As Visio.Shape
    Set vsoShape1 = ActivePage.DrawRectangle(0, 0, 0, 0)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "Width*0"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "Height*0"
' =====
    Set vsoShape1 = ActivePage.DrawRectangle(2, 2, 4, 4)
    vsoShape1.TextStyle = "Normal"
    vsoShape1.NameU = "Autor"
    vsoShape1.LineStyle = "Text Only"
    vsoShape1.FillStyle = "Text Only"
    vsoShape1.Text = "THIS IS MY TEXT"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "Width*0"
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "Height*0"
End Sub


i create my gif with LICEcap application