visio textbox resize

[joemo2003]

I use the follow code to resize the textbox in visio, anybody know what is wrong?

Dim ashape as visio.shape
ashape.CellsU("TxtWidth").Formula = "=TEXTWIDTH(TheText)"
 

Thanks

[joemo2003]

or I want to maximize the textbox, so

ashape.Formula = "Max(TEXTWIDTH(TheText), 8 * Char.Size)"
 

Any help on either way will be great.

[joemo2003]

or I want to maximize the textbox, so

ashape.Formula = "Max(TEXTWIDTH(TheText), 8 * Char.Size)"
 

Any help on either way will be great.

seem like the ashape.Formula is wrong.

[joemo2003]

seem like the ashape.Formula is wrong.

that is wrong.

[joemo2003]

that is wrong.

Samm help.

[joemo2003]

Forget everthing above,

Dim celObjWidth As Visio.Cell
Set celObjWidth = ashape.Cells("width")
If ashape.Text = sFind Then
ashape.Text = sFind & Chr(10) & sReplacement
End if
celObjWidth.Formula = "=GUARD(TEXTWIDTH(TheText))"
 

this code actually work, but not only resize the textbox, but also resize all the other shape.

help

[SammyB]

Samm help.

:) No Visio untill tonight, 9PM EST. Can't you just record a macro in Visio that does the resize and look at the code that it generates?

[joemo2003]

samm,
when you have visio with you, could you test another thing for me too.
I need to input text to visio with mutiple pages, the follow code is working for me

For k=1 To 5
Set apage = vsDoc.Pages(k)
...
Next k
 

The thing is the code above need to tell the page number (5), but the page may be varied on other visio files, is there a code something like
vsDoc.Pages(End)?

thanks

[SammyB]

samm,
when you have visio with you, could you test another thing for me too.
I need to input text to visio with mutiple pages, the follow code is working for me

For k=1 To 5
Set apage = vsDoc.Pages(k)
...
Next k
 

The thing is the code above need to tell the page number (5), but the page may be varied on other visio files, is there a code something like
vsDoc.Pages(End)?

thanks

For width & height, this works for me:

If s.Text = sFind Then
    s.Text = sReplacement
    s.Cells("Height").Formula = "40mm"
    s.Cells("Width").Formula = "60mm"
End If

For number of pages, just use Pages.Count:

MsgBox vsDoc.Pages.Count
Set vsLastPage = vsDoc.Pages(vsDoc.Pages.Count)

[joemo2003]

Do u still remember the resize text font you help me before?

ashape.Text = sFind & Chr(10) & sReplacement
 

This time I only want to resize the sReplacement, but not the sFind,
If i use

Dim aCell As Visio.Cell
Set aCell = ashape.Text("Char.size")
aCell.Formula="12pt"
 

it will resize include the sFind. So how to resize partially?
thanks

[SammyB]

Do u still remember the resize text font you help me before?

ashape.Text = sFind & Chr(10) & sReplacement
 

This time I only want to resize the sReplacement, but not the sFind,
If i use

Dim aCell As Visio.Cell
Set aCell = ashape.Text("Char.size")
aCell.Formula="12pt"
 

it will resize include the sFind. So how to resize partially?
thanks

You use the Characters object:

    Dim s As String, i As Integer
    s = "Not Fun"
    Dim c As Characters
    Set c = ActivePage.Shapes(1).Characters
    i = InStr(c.Text, s)
    c.Begin = i - 1
    c.End = i - 1 + Len(s)
    c.CharProps(visCharacterSize) = 16
    c.CharProps(visCharacterStyle) = visBold + visItalic
    c.CharProps(visCharacterColor) = visRed

In this example, "Not Fun" is your replacement text. It is set to 16 point, bold, italic, & red. HTH --Sam

[SammyB]

BTW, I found a Web Site with info on Visio programming! See http://www.design-drawing.com/visio/.

Also, a DoCMD reference, http://www.mster.co.jp/visiosquare/c...2/index01.html

So, if I learn Jananese, I can be really dangerous! ;)

[SammyB]

Also, a book:
Learn Microsoft Visio 2002 for the Advanced User by Ralph Grabowski and Frank Zander

[joemo2003]

You use the Characters object:

    Dim s As String, i As Integer
    s = "Not Fun"
    Dim c As Characters
    Set c = ActivePage.Shapes(1).Characters
    i = InStr(c.Text, s)
    c.Begin = i - 1
    c.End = i - 1 + Len(s)
    c.CharProps(visCharacterSize) = 16
    c.CharProps(visCharacterStyle) = visBold + visItalic
    c.CharProps(visCharacterColor) = visRed

In this example, "Not Fun" is your replacement text. It is set to 16 point, bold, italic, & red. HTH --Sam

I use

For Each ashape In apage.Shapes 
...
Set c = ashape.Characters
...
next ashape
 

when I debug it, that "ashape.Characters" return nothing. It said "type mismatch". Why is that happen?

[joemo2003]

I use

For Each ashape In apage.Shapes 
...
Set c = ashape.Characters
...
next ashape
 

when I debug it, that "ashape.Characters" return nothing. It said "type mismatch". Why is that happen?

Well, the "ashape.Characters" do return something, but the "c" is empty.

[SammyB]

Well, the "ashape.Characters" do return something, but the "c" is empty.

Remember, you are in a multiple application world (Excel & Visio). c should be Dim'ed as Visio.Characters. My sample was just a Visio macro. Keep :)!

[joemo2003]

Remember, you are in a multiple application world (Excel & Visio). c should be Dim'ed as Visio.Characters. My sample was just a Visio macro. Keep :)!

great, that work. One more question, how to use the SaveAsEx function?
I try to save the same file name with extension date and time, but all I know is use the vsDoc.save or vsApp.DoCmd(visCmdFileSave).

[SammyB]

great, that work. One more question, how to use the SaveAsEx function?
I try to save the same file name with extension date and time, but all I know is use the vsDoc.save or vsApp.DoCmd(visCmdFileSave).

    Dim sNew As String
    sNew = Split(ActiveDocument.Name, ".")(0) ' Strip filetype
    sNew = sNew & "-" & Format(Now(), "yyyy-mm-dd") & ".vsd"
    MsgBox "Saving chart as readonly in " & sNew
    ActiveDocument.SaveAsEx sNew, visSaveAsRO

[joemo2003]

great, everthing work good. hopefully my boss will like it. Thanks, sam

[joemo2003]

I think the use the DoCmd to open visio is simpler than the one you help me before.

Set vsApp = New Visio.Application
vsApp.DoCmd (visCmdFileOpen)
 

the code work for select and open the visio, but error occur when click cancel.
How can I make the cancel work too?

[SammyB]

I think the use the DoCmd to open visio is simpler than the one you help me before.

Set vsApp = New Visio.Application
vsApp.DoCmd (visCmdFileOpen)
 

the code work for select and open the visio, but error occur when click cancel.
How can I make the cancel work too?

It's not simpler if it doesn't work. Use Excel.GetOpenFilename and make the response a Variant. If the user presses Cancel, then the Variant is False. Weird, but standard Microsoft:

    Dim vFile As Variant
    vFile = Application.GetOpenFilename("All Visio Files (*.vs*;*.v?x), *.vs*;*.v?x")
    If vFile = False Then Exit Sub
    MsgBox "Open Visio file, " & vFile
 

You can get DoCmd to work, but it's not pretty.

    Dim vsApp As Visio.Application
    Dim vsDoc As Visio.Document
    Set vsApp = CreateObject("Visio.Application")
    On Error GoTo PressedCancel
    vsApp.DoCmd (visCmdFileOpen)
    On Error GoTo 0                 ' Resume normal error processing
    Set vsDoc = vsApp.ActiveDocument
    MsgBox "Continue Processing..."
    Exit Sub
PressedCancel:
    vsApp.Quit
 

[joemo2003]

It's not simpler if it doesn't work. Use Excel.GetOpenFilename and make the response a Variant. If the user presses Cancel, then the Variant is False. Weird, but standard Microsoft:

    Dim vFile As Variant
    vFile = Application.GetOpenFilename("All Visio Files (*.vs*;*.v?x), *.vs*;*.v?x")
    If vFile = False Then Exit Sub
    MsgBox "Open Visio file, " & vFile
 

You can get DoCmd to work, but it's not pretty.

    Dim vsApp As Visio.Application
    Dim vsDoc As Visio.Document
    Set vsApp = CreateObject("Visio.Application")
    On Error GoTo PressedCancel
    vsApp.DoCmd (visCmdFileOpen)
    On Error GoTo 0                 ' Resume normal error processing
    Set vsDoc = vsApp.ActiveDocument
    MsgBox "Continue Processing..."
    Exit Sub
PressedCancel:
    vsApp.Quit
 

The reason I want to use the DoCmd is it pass te fully path and filename to the opened file, but GetOpenFilename does not. Thanks a lot, that DoCmd is working now.

[joemo2003]

Sam, help again.

In commondbutton1, I have

Dim vsDocs As Visio.Documents
Dim vsDoc As Visio.Document
Set vsDocs = vsApp.Documents
Set vsDoc = vsDocs.Open("D:\folderxx\test.vsd")
Set vsDoc = vsApp.ActiveDocument
vsApp.Visible = False
 

in commondbutton 2, I have

sNew = Split(vsDoc.Name, ".")(0)
sNew = sNew & "(" & Format(Now(), "MM_dd_yyyy") & ".vsd"
vsApp.ActiveDocument.SaveAsEx sNew, visSaveAsRO
vsApp.quit
 

When it save the file, it lost the path and save to a temporally folder in C: drive, how to make it save to where the file come from (the D: drive)? It save back to D: drive when I use the DoCmd(visCmdFileOpen), but this time I need to specified the file name in the code.

[SammyB]

Visio.ActiveDocument.Path

[joemo2003]

Visio.ActiveDocument.Path

I still cannot figure out how to use the path function. can you specify little bit more?

[SammyB]

I still cannot figure out how to use the path function. can you specify little bit more?

Putting the Open/Close all together, I have:

 Sub OpenExisting()
    Dim vsApp As Visio.Application
    Dim vsDoc As Visio.Document
    Set vsApp = CreateObject("Visio.Application")
    On Error GoTo PressedCancel
    vsApp.DoCmd (visCmdFileOpen)
    On Error GoTo 0             ' Resume normal error processing
    Set vsDoc = vsApp.ActiveDocument
    MsgBox "Continue Processing..."
    Dim sNew As String
    sNew = Split(vsDoc.Name, ".")(0)
    sNew = sNew & "-" & Format(Now(), "MM_dd_yyyy") & ".vsd"
    vsApp.ActiveDocument.SaveAsEx vsDoc.Path & sNew, visSaveAsRO
    vsApp.Quit
PressedCancel:
    vsApp.Quit
End Sub

Is that clear or is there something that needs explanation? BTW When you run a macro, you can press the "Step Into" button and step through your code with the F8 key. As you step through it, when you hover the mouse over a property or variable, the IDE shows you the value. It really helps to understand/debug. Also, you can click on a variable, and use the menu Debug, Add Watch. For example, after "Set vsDoc = vsApp.ActiveDocument", if you set a watch on vsDoc, then by clicking on the plus signs, you can see all of the current properties of the document. --Sam

[joemo2003]

Putting the Open/Close all together, I have:

 Sub OpenExisting()
    Dim vsApp As Visio.Application
    Dim vsDoc As Visio.Document
    Set vsApp = CreateObject("Visio.Application")
    On Error GoTo PressedCancel
    vsApp.DoCmd (visCmdFileOpen)
    On Error GoTo 0             ' Resume normal error processing
    Set vsDoc = vsApp.ActiveDocument
    MsgBox "Continue Processing..."
    Dim sNew As String
    sNew = Split(vsDoc.Name, ".")(0)
    sNew = sNew & "-" & Format(Now(), "MM_dd_yyyy") & ".vsd"
    vsApp.ActiveDocument.SaveAsEx vsDoc.Path & sNew, visSaveAsRO
    vsApp.Quit
PressedCancel:
    vsApp.Quit
End Sub

Is that clear or is there something that needs explanation? BTW When you run a macro, you can press the "Step Into" button and step through your code with the F8 key. As you step through it, when you hover the mouse over a property or variable, the IDE shows you the value. It really helps to understand/debug. Also, you can click on a variable, and use the menu Debug, Add Watch. For example, after "Set vsDoc = vsApp.ActiveDocument", if you set a watch on vsDoc, then by clicking on the plus signs, you can see all of the current properties of the document. --Sam

thanks, that help a lot.

[joemo2003]

You use the Characters object:

    Dim s As String, i As Integer
    s = "Not Fun"
    Dim c As Characters
    Set c = ActivePage.Shapes(1).Characters
    i = InStr(c.Text, s)
    c.Begin = i - 1
    c.End = i - 1 + Len(s)
    c.CharProps(visCharacterSize) = 16
    c.CharProps(visCharacterStyle) = visBold + visItalic
    c.CharProps(visCharacterColor) = visRed

In this example, "Not Fun" is your replacement text. It is set to 16 point, bold, italic, & red. HTH --Sam

Sam, do you still remember this code? It's on page 2. Is there anyway to break down the replacement text and set to difference size? Just like in your code, s="Not Fun", how to make "Not" to size 16, and "Fun" to size 10. The condition is the "Not" in one row, and the "Fun" in another row.

Thanks

[SammyB]

Sam, do you still remember this code? It's on page 2. Is there anyway to break down the replacement text and set to difference size? Just like in your code, s="Not Fun", how to make "Not" to size 16, and "Fun" to size 10. The condition is the "Not" in one row, and the "Fun" in another row.

Thanks

So, you want the first row of text to be 16 and the second row to be 10 for all of your Visio shapes? In that case, I would just iterate through all of the Visio shapes after you've done the replacement.

[joemo2003]

So, you want the first row of text to be 16 and the second row to be 10 for all of your Visio shapes? In that case, I would just iterate through all of the Visio shapes after you've done the replacement.

yeah, but only to the replacement text.

[SammyB]

yeah, but only to the replacement text.

Well then, I would have a sReplace1 and an sReplace2 or if there are a variable number of replacement rows, have an array of replacement text.

[joemo2003]

Well then, I would have a sReplace1 and an sReplace2 or if there are a variable number of replacement rows, have an array of replacement text.

but how to break the replacement text to sReplace1, sReplace2?

[SammyB]

but how to break the replacement text to sReplace1, sReplace2?

You already have it that way in Excel. When you are getting it from Excel, don't concatinate the replacement rows together.

[joemo2003]

You already have it that way in Excel. When you are getting it from Excel, don't concatinate the replacement rows together.

I thought about that before, but look at my code,

'ws1 is sheet 1, ws2 is sheet 2
'iRow=ws1.Cells(j, 5).value
sReplacement = sReplacement &ws1.Cells(j, 6).Text _
                    & ws2.Cells(iRow, i).Text & " " & ws.Cells(j, 7).Text & Chr(10)
 

how can I separate the row?

[joemo2003]

i think i can just not use the loop but write it out one row by one row for the replacemet text.
Another question, how to set multiply vsDoc as active document? So i can input text to multiply drawing.

[joemo2003]

i think i can just not use the loop but write it out one row by one row for the replacemet text.
Another question, how to set multiply vsDoc as active document? So i can input text to multiply drawing.

got the row format slove, but still cannot figure out how to input to multiply file.

[SammyB]

got the row format slove, but still cannot figure out how to input to multiply file.

multiply file? :confused:
Go slower and give more details

[joemo2003]

multiply file? :confused:
Go slower and give more details

In excel have three button, two button open two visio drawing directly, they look like:

Set vsDoc = vsDocs.Open(C:\folder\file#.vsd)
 

and third button use to input the text to those two drawing, but it only can input text to the last opened drawing, not both. I try use for loop

for each vsdoc in vsapp.documents
...
next vsdoc
 

but it still input text to only one drawing.

[SammyB]

In excel have three button, two button open two visio drawing directly, they look like:

Set vsDoc = vsDocs.Open(C:\folder\file#.vsd)
 

and third button use to input the text to those two drawing, but it only can input text to the last opened drawing, not both. I try use for loop

for each vsdoc in vsapp.documents
...
next vsdoc
 

but it still input text to only one drawing.

Well, you must have two Visio Applications. In the button code, you need to check the global, vsApp. If vsApp Is Nothing, then you start Visio, otherwise, you just use vsApp. But, make sure that vsApp is only defined in one place: in the Code module (Module1).

[joemo2003]

Well, you must have two Visio Applications. In the button code, you need to check the global, vsApp. If vsApp Is Nothing, then you start Visio, otherwise, you just use vsApp. But, make sure that vsApp is only defined in one place: in the Code module (Module1).

The two visio application already open before press the input text button. Should I check if vsApp is Nothing in the input text button? but it is already open, it cannot open again.

[joemo2003]

The two visio application already open before press the input text button. Should I check if vsApp is Nothing in the input text button? but it is already open, it cannot open again.

Never Mind. I don't need to input to multiple application.