By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
455,082 Members | 1,160 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 455,082 IT Pros & Developers. It's quick & easy.

visio textbox resize

100+
P: 142
I use the follow code to resize the textbox in visio, anybody know what is wrong?

Expand|Select|Wrap|Line Numbers
  1. Dim ashape as visio.shape
  2. ashape.CellsU("TxtWidth").Formula = "=TEXTWIDTH(TheText)"
  3.  
Thanks
Apr 2 '07 #1
Share this Question
Share on Google+
40 Replies


100+
P: 142
or I want to maximize the textbox, so
Expand|Select|Wrap|Line Numbers
  1. ashape.Formula = "Max(TEXTWIDTH(TheText), 8 * Char.Size)"
  2.  
Any help on either way will be great.
Apr 2 '07 #2

100+
P: 142
or I want to maximize the textbox, so
Expand|Select|Wrap|Line Numbers
  1. ashape.Formula = "Max(TEXTWIDTH(TheText), 8 * Char.Size)"
  2.  
Any help on either way will be great.
seem like the ashape.Formula is wrong.
Apr 3 '07 #3

100+
P: 142
seem like the ashape.Formula is wrong.
that is wrong.
Apr 3 '07 #4

100+
P: 142
that is wrong.
Samm help.
Apr 3 '07 #5

100+
P: 142
Forget everthing above,

Expand|Select|Wrap|Line Numbers
  1. Dim celObjWidth As Visio.Cell
  2. Set celObjWidth = ashape.Cells("width")
  3. If ashape.Text = sFind Then
  4. ashape.Text = sFind & Chr(10) & sReplacement
  5. End if
  6. celObjWidth.Formula = "=GUARD(TEXTWIDTH(TheText))"
  7.  
this code actually work, but not only resize the textbox, but also resize all the other shape.

help
Apr 3 '07 #6

SammyB
Expert 100+
P: 807
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?
Apr 3 '07 #7

100+
P: 142
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
Expand|Select|Wrap|Line Numbers
  1. For k=1 To 5
  2. Set apage = vsDoc.Pages(k)
  3. ...
  4. Next k
  5.  
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
Apr 3 '07 #8

SammyB
Expert 100+
P: 807
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
Expand|Select|Wrap|Line Numbers
  1. For k=1 To 5
  2. Set apage = vsDoc.Pages(k)
  3. ...
  4. Next k
  5.  
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:
Expand|Select|Wrap|Line Numbers
  1. If s.Text = sFind Then
  2.     s.Text = sReplacement
  3.     s.Cells("Height").Formula = "40mm"
  4.     s.Cells("Width").Formula = "60mm"
  5. End If
For number of pages, just use Pages.Count:
Expand|Select|Wrap|Line Numbers
  1. MsgBox vsDoc.Pages.Count
  2. Set vsLastPage = vsDoc.Pages(vsDoc.Pages.Count)
Apr 4 '07 #9

100+
P: 142
Do u still remember the resize text font you help me before?
Expand|Select|Wrap|Line Numbers
  1. ashape.Text = sFind & Chr(10) & sReplacement
  2.  
This time I only want to resize the sReplacement, but not the sFind,
If i use
Expand|Select|Wrap|Line Numbers
  1. Dim aCell As Visio.Cell
  2. Set aCell = ashape.Text("Char.size")
  3. aCell.Formula="12pt"
  4.  
it will resize include the sFind. So how to resize partially?
thanks
Apr 4 '07 #10

SammyB
Expert 100+
P: 807
Do u still remember the resize text font you help me before?
Expand|Select|Wrap|Line Numbers
  1. ashape.Text = sFind & Chr(10) & sReplacement
  2.  
This time I only want to resize the sReplacement, but not the sFind,
If i use
Expand|Select|Wrap|Line Numbers
  1. Dim aCell As Visio.Cell
  2. Set aCell = ashape.Text("Char.size")
  3. aCell.Formula="12pt"
  4.  
it will resize include the sFind. So how to resize partially?
thanks
You use the Characters object:
Expand|Select|Wrap|Line Numbers
  1.     Dim s As String, i As Integer
  2.     s = "Not Fun"
  3.     Dim c As Characters
  4.     Set c = ActivePage.Shapes(1).Characters
  5.     i = InStr(c.Text, s)
  6.     c.Begin = i - 1
  7.     c.End = i - 1 + Len(s)
  8.     c.CharProps(visCharacterSize) = 16
  9.     c.CharProps(visCharacterStyle) = visBold + visItalic
  10.     c.CharProps(visCharacterColor) = visRed
In this example, "Not Fun" is your replacement text. It is set to 16 point, bold, italic, & red. HTH --Sam
Apr 4 '07 #11

SammyB
Expert 100+
P: 807
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! ;)
Apr 4 '07 #12

SammyB
Expert 100+
P: 807
Also, a book:
Learn Microsoft Visio 2002 for the Advanced User by Ralph Grabowski and Frank Zander
Apr 4 '07 #13

100+
P: 142
You use the Characters object:
Expand|Select|Wrap|Line Numbers
  1.     Dim s As String, i As Integer
  2.     s = "Not Fun"
  3.     Dim c As Characters
  4.     Set c = ActivePage.Shapes(1).Characters
  5.     i = InStr(c.Text, s)
  6.     c.Begin = i - 1
  7.     c.End = i - 1 + Len(s)
  8.     c.CharProps(visCharacterSize) = 16
  9.     c.CharProps(visCharacterStyle) = visBold + visItalic
  10.     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
Expand|Select|Wrap|Line Numbers
  1. For Each ashape In apage.Shapes 
  2. ...
  3. Set c = ashape.Characters
  4. ...
  5. next ashape
  6.  
when I debug it, that "ashape.Characters" return nothing. It said "type mismatch". Why is that happen?
Apr 4 '07 #14

100+
P: 142
I use
Expand|Select|Wrap|Line Numbers
  1. For Each ashape In apage.Shapes 
  2. ...
  3. Set c = ashape.Characters
  4. ...
  5. next ashape
  6.  
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.
Apr 4 '07 #15

SammyB
Expert 100+
P: 807
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 :)!
Apr 4 '07 #16

100+
P: 142
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).
Apr 4 '07 #17

SammyB
Expert 100+
P: 807
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).
Expand|Select|Wrap|Line Numbers
  1.     Dim sNew As String
  2.     sNew = Split(ActiveDocument.Name, ".")(0) ' Strip filetype
  3.     sNew = sNew & "-" & Format(Now(), "yyyy-mm-dd") & ".vsd"
  4.     MsgBox "Saving chart as readonly in " & sNew
  5.     ActiveDocument.SaveAsEx sNew, visSaveAsRO
Apr 4 '07 #18

100+
P: 142
great, everthing work good. hopefully my boss will like it. Thanks, sam
Apr 4 '07 #19

100+
P: 142
I think the use the DoCmd to open visio is simpler than the one you help me before.
Expand|Select|Wrap|Line Numbers
  1. Set vsApp = New Visio.Application
  2. vsApp.DoCmd (visCmdFileOpen)
  3.  
the code work for select and open the visio, but error occur when click cancel.
How can I make the cancel work too?
Apr 4 '07 #20

SammyB
Expert 100+
P: 807
I think the use the DoCmd to open visio is simpler than the one you help me before.
Expand|Select|Wrap|Line Numbers
  1. Set vsApp = New Visio.Application
  2. vsApp.DoCmd (visCmdFileOpen)
  3.  
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:
Expand|Select|Wrap|Line Numbers
  1.     Dim vFile As Variant
  2.     vFile = Application.GetOpenFilename("All Visio Files (*.vs*;*.v?x), *.vs*;*.v?x")
  3.     If vFile = False Then Exit Sub
  4.     MsgBox "Open Visio file, " & vFile
  5.  
You can get DoCmd to work, but it's not pretty.
Expand|Select|Wrap|Line Numbers
  1.     Dim vsApp As Visio.Application
  2.     Dim vsDoc As Visio.Document
  3.     Set vsApp = CreateObject("Visio.Application")
  4.     On Error GoTo PressedCancel
  5.     vsApp.DoCmd (visCmdFileOpen)
  6.     On Error GoTo 0                 ' Resume normal error processing
  7.     Set vsDoc = vsApp.ActiveDocument
  8.     MsgBox "Continue Processing..."
  9.     Exit Sub
  10. PressedCancel:
  11.     vsApp.Quit
  12.  
Apr 5 '07 #21

100+
P: 142
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:
Expand|Select|Wrap|Line Numbers
  1.     Dim vFile As Variant
  2.     vFile = Application.GetOpenFilename("All Visio Files (*.vs*;*.v?x), *.vs*;*.v?x")
  3.     If vFile = False Then Exit Sub
  4.     MsgBox "Open Visio file, " & vFile
  5.  
You can get DoCmd to work, but it's not pretty.
Expand|Select|Wrap|Line Numbers
  1.     Dim vsApp As Visio.Application
  2.     Dim vsDoc As Visio.Document
  3.     Set vsApp = CreateObject("Visio.Application")
  4.     On Error GoTo PressedCancel
  5.     vsApp.DoCmd (visCmdFileOpen)
  6.     On Error GoTo 0                 ' Resume normal error processing
  7.     Set vsDoc = vsApp.ActiveDocument
  8.     MsgBox "Continue Processing..."
  9.     Exit Sub
  10. PressedCancel:
  11.     vsApp.Quit
  12.  
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.
Apr 5 '07 #22

100+
P: 142
Sam, help again.

In commondbutton1, I have
Expand|Select|Wrap|Line Numbers
  1. Dim vsDocs As Visio.Documents
  2. Dim vsDoc As Visio.Document
  3. Set vsDocs = vsApp.Documents
  4. Set vsDoc = vsDocs.Open("D:\folderxx\test.vsd")
  5. Set vsDoc = vsApp.ActiveDocument
  6. vsApp.Visible = False
  7.  
in commondbutton 2, I have
Expand|Select|Wrap|Line Numbers
  1. sNew = Split(vsDoc.Name, ".")(0)
  2. sNew = sNew & "(" & Format(Now(), "MM_dd_yyyy") & ".vsd"
  3. vsApp.ActiveDocument.SaveAsEx sNew, visSaveAsRO
  4. vsApp.quit
  5.  
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.
Apr 5 '07 #23

SammyB
Expert 100+
P: 807
Visio.ActiveDocument.Path
Apr 5 '07 #24

100+
P: 142
Visio.ActiveDocument.Path
I still cannot figure out how to use the path function. can you specify little bit more?
Apr 6 '07 #25

SammyB
Expert 100+
P: 807
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:
Expand|Select|Wrap|Line Numbers
  1.  Sub OpenExisting()
  2.     Dim vsApp As Visio.Application
  3.     Dim vsDoc As Visio.Document
  4.     Set vsApp = CreateObject("Visio.Application")
  5.     On Error GoTo PressedCancel
  6.     vsApp.DoCmd (visCmdFileOpen)
  7.     On Error GoTo 0             ' Resume normal error processing
  8.     Set vsDoc = vsApp.ActiveDocument
  9.     MsgBox "Continue Processing..."
  10.     Dim sNew As String
  11.     sNew = Split(vsDoc.Name, ".")(0)
  12.     sNew = sNew & "-" & Format(Now(), "MM_dd_yyyy") & ".vsd"
  13.     vsApp.ActiveDocument.SaveAsEx vsDoc.Path & sNew, visSaveAsRO
  14.     vsApp.Quit
  15. PressedCancel:
  16.     vsApp.Quit
  17. 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
Apr 6 '07 #26

100+
P: 142
Putting the Open/Close all together, I have:
Expand|Select|Wrap|Line Numbers
  1.  Sub OpenExisting()
  2.     Dim vsApp As Visio.Application
  3.     Dim vsDoc As Visio.Document
  4.     Set vsApp = CreateObject("Visio.Application")
  5.     On Error GoTo PressedCancel
  6.     vsApp.DoCmd (visCmdFileOpen)
  7.     On Error GoTo 0             ' Resume normal error processing
  8.     Set vsDoc = vsApp.ActiveDocument
  9.     MsgBox "Continue Processing..."
  10.     Dim sNew As String
  11.     sNew = Split(vsDoc.Name, ".")(0)
  12.     sNew = sNew & "-" & Format(Now(), "MM_dd_yyyy") & ".vsd"
  13.     vsApp.ActiveDocument.SaveAsEx vsDoc.Path & sNew, visSaveAsRO
  14.     vsApp.Quit
  15. PressedCancel:
  16.     vsApp.Quit
  17. 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.
Apr 6 '07 #27

100+
P: 142
You use the Characters object:
Expand|Select|Wrap|Line Numbers
  1.     Dim s As String, i As Integer
  2.     s = "Not Fun"
  3.     Dim c As Characters
  4.     Set c = ActivePage.Shapes(1).Characters
  5.     i = InStr(c.Text, s)
  6.     c.Begin = i - 1
  7.     c.End = i - 1 + Len(s)
  8.     c.CharProps(visCharacterSize) = 16
  9.     c.CharProps(visCharacterStyle) = visBold + visItalic
  10.     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
Apr 11 '07 #28

SammyB
Expert 100+
P: 807
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.
Apr 11 '07 #29

100+
P: 142
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.
Apr 11 '07 #30

SammyB
Expert 100+
P: 807
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.
Apr 11 '07 #31

100+
P: 142
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?
Apr 11 '07 #32

SammyB
Expert 100+
P: 807
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.
Apr 11 '07 #33

100+
P: 142
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,
Expand|Select|Wrap|Line Numbers
  1. 'ws1 is sheet 1, ws2 is sheet 2
  2. 'iRow=ws1.Cells(j, 5).value
  3. sReplacement = sReplacement &ws1.Cells(j, 6).Text _
  4.                     & ws2.Cells(iRow, i).Text & " " & ws.Cells(j, 7).Text & Chr(10)
  5.  
how can I separate the row?
Apr 11 '07 #34

100+
P: 142
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.
Apr 12 '07 #35

100+
P: 142
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.
Apr 12 '07 #36

SammyB
Expert 100+
P: 807
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
Apr 12 '07 #37

100+
P: 142
multiply file? :confused:
Go slower and give more details
In excel have three button, two button open two visio drawing directly, they look like:
Expand|Select|Wrap|Line Numbers
  1. Set vsDoc = vsDocs.Open(C:\folder\file#.vsd)
  2.  
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
Expand|Select|Wrap|Line Numbers
  1. for each vsdoc in vsapp.documents
  2. ...
  3. next vsdoc
  4.  
but it still input text to only one drawing.
Apr 12 '07 #38

SammyB
Expert 100+
P: 807
In excel have three button, two button open two visio drawing directly, they look like:
Expand|Select|Wrap|Line Numbers
  1. Set vsDoc = vsDocs.Open(C:\folder\file#.vsd)
  2.  
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
Expand|Select|Wrap|Line Numbers
  1. for each vsdoc in vsapp.documents
  2. ...
  3. next vsdoc
  4.  
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).
Apr 12 '07 #39

100+
P: 142
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.
Apr 13 '07 #40

100+
P: 142
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.
Apr 13 '07 #41

Post your reply

Sign in to post your reply or Sign up for a free account.