Solved

Visio Template opened from Excel Userform

Posted on 2007-11-26
4
1,586 Views
Last Modified: 2010-04-21
I have created an Excel Userform that completes the following tasks, once the questions on the userform are completed and the enduser selects the submit button:

Creates a folder, which is the name of the site address and saves it under the company no. folder
Copies and pastes each worksheet into Word saves in the folder
Opens a Visio Template and saves it as a Visio document in the folder
Open a Word Template and saves it as a Word Template in the folder

The macro that I have created (with help) works fine; however, I need to make changes to it and I am not sure the best way to accomplish this request.

In the current macro, if the enduser updates anything on the userform and selects submit, the Visio document is overwritten and when the Visio document is created and opened, if the enduser closes it at that time and reopens it later to complete the site drawings, the stencils are not present and must be manually added.

Here are my questions.  

How do I eliminate the Visio document from being overwritten?
What is a better way of saving the Visio document, so that enduser will still have the stencil loaded and appear to the left of the drawing?
Is it possible to save the Visio template as a Visio template, but add a textbox that contains that site address?  If so, I could add code so the stencils would load properly.

I have added my code below.
Thanks in advance for your help!
Chesterfieldfire

Sub CommandButton1_Click()

      

Dim fs, fl1, fl2, filepath1 As String, filepath2 As String, addr As String, obj As Word.Application, vsoDocument As Visio.Document, addr1 As String
 

Set fs = CreateObject("Scripting.FileSystemObject")

filepath1 = "V:\Operations\Pre-plans\Station " & cboCompany & "\"

addr1 = UserForm2.tbxStreetName
 

On Error Resume Next

Set fl1 = fs.GetFolder(filepath1)

Set fl1 = fs.CreateFolder(filepath1)

On Error GoTo 0
 

If addr1 = "" Then

UserForm3.Hide

MsgBox "Please enter Full Street Address."

UserForm2.Show
 

ElseIf Not addr1 = "" Then
 

addr = txtAddress 'Where does this come from? Use the appropriate variable or cell address

filepath2 = filepath1 & addr & "\"
 

On Error Resume Next

Set fl2 = fs.GetFolder(filepath2)

Set fl2 = fs.CreateFolder(filepath2)
 

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs filepath2 & addr & ".xls"

Application.DisplayAlerts = True
 

Worksheets("PrePlan").Activate  'Activate the worksheet

    'Select the range of cells to copy

    Worksheets("PrePlan").Range("a1:b201").Copy

      

    Set obj = CreateObject("Word.Application.11")  'Create a word object

    obj.Visible = False 'Make Word visible

    Set newDoc = obj.Documents.Add  'Create a new file.

   

    'Determine if Microsoft Excel is running on the Macintosh or Windows.

    If (Application.OperatingSystem Like "*Mac*") Then

        AppActivate "Microsoft word"

        obj.Selection.PasteSpecial  'Paste data into Word

      

    Else  'If Windows NT/95/3.x - paste data into Word

        obj.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteRTF

    End If

   

   With ActiveDocument.PageSetup

    .MirrorMargins = True

    .LeftMargin = InchesToPoints(0.75)

    .RightMargin = InchesToPoints(0.75)

    .TopMargin = InchesToPoints(0.75)

    .BottomMargin = InchesToPoints(0.75)

    End With

   

       'Format table

    obj.Selection.Tables(1).AutoFormat Format:=wdTableFormatGrid1

    newDoc.SaveAs filepath2 & addr & "-PrePlan" & ".doc"  'Save the file

    

    obj.Quit  'Quit Word

    Set obj = Nothing 'Release object

    'release range selection

    Application.CutCopyMode = False

    

Worksheets("SnapShot").Activate  'Activate the worksheet

    'Select the range of cells to copy

    Worksheets("SnapShot").Range("a2:b53").Copy

      

    Set obj = CreateObject("Word.Application.11")  'Create a word object

    obj.Visible = False 'Make Word visible

    Set newDoc = obj.Documents.Add  'Create a new file.

   

    'Determine if Microsoft Excel is running on the Macintosh or Windows.

    If (Application.OperatingSystem Like "*Mac*") Then

        AppActivate "Microsoft word"

        obj.Selection.PasteSpecial  'Paste data into Word

      

    Else  'If Windows NT/95/3.x - paste data into Word

        obj.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteRTF

    End If

   

    With ActiveDocument.PageSetup

    .MirrorMargins = True

    .LeftMargin = InchesToPoints(0.75)

    .RightMargin = InchesToPoints(0.75)

    .TopMargin = InchesToPoints(0.75)

    .BottomMargin = InchesToPoints(0.75)

    End With

   'Format table

    obj.Selection.Tables(1).AutoFormat Format:=wdTableFormatGrid1

    newDoc.SaveAs filepath2 & addr & "-SnapShot" & ".doc"  'Save the file

    obj.Quit  'Quit Word

    Set obj = Nothing 'Release object

    'release range selection

    Application.CutCopyMode = False

    

    Dim VisioApp As Object, VisioDoc As Object
 

    On Error Resume Next

   

    Set VisioApp = GetObject(, "Visio.Application")

    If Err.Number <> 0 Then

        Err.Clear

        Set VisioApp = CreateObject("Visio.Application")

    End If
 

    Set VisioDoc = VisioApp.Documents("Pre-Plan Template.vst")

    Set VisioDoc = VisioApp.Documents.Open("V:\Operations\Pre-plans\Station 1\Supporting documents\Visio Template\Pre-Plan Template.vst")

        

    VisioDoc.SaveAs filepath2 & addr & ".vst"  'Save the file

    VisioApp.Visible = True
 

    Dim WordApp As Object, WordDoc As Object
 

    On Error Resume Next

   

    Set WordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then

        Err.Clear

        Set WordApp = CreateObject("Word.Application")

    End If
 

    Set WordDoc = WordApp.Documents("Tenant Merchant Form.dot")

    Set WordDoc = WordApp.Documents.Open("V:\Operations\Pre-plans\Station 1\Supporting documents\Tenant Merchant Form.dot")

        

    WordDoc.SaveAs filepath2 & addr & ".doc"  'Save the file

    WordApp.Visible = True

    

    'return cursor to starting position

    Worksheets("PrePlan").Activate

    Range("A1").Select

    

    UserForm3.Hide
 

    Msg = "Final forms submitted successfully."

Answer = MsgBox(Msg, vbOKOnly)
 

Set fl1 = Nothing: Set fl2 = Nothing: Set fs = Nothing
 

ThisWorkbook.Close False

Application.Quit
 

End If

End Sub

Open in new window

0
Comment
Question by:ChesterfieldFire
  • 2
  • 2
4 Comments
 
LVL 30

Accepted Solution

by:
Scott Helmers earned 500 total points
Comment Utility
Let me answer your question about the stencil first: you can use a slightly different save command to tell Visio to save not just the document but also the workspace (the Visio workspace includes both the drawing window plus any open stencils). This should eliminate the need to write any code to open the stencil -- it will open automatically whenever the saved document is reopened.

Instead of
     VisioDoc.SaveAs filepath2 & addr & ".vst"     'Save the file
use this:
     VisioDoc.SaveAsEx filepath2 & addr & ".vst", visSaveAsWS      'Save the file

Note the two key differences: 1) use of SaveAsEx instead of SaveAs and 2) the addition of a parameter to tell Visio to save the workspace (vsSaveAsWS) along with the file.

To avoid having the document overwritten, you could alter the code to use a different name each time, perhaps asking the user for the desired filename. However, I'm not sure I understand why the file is ever overwritten, at least not without asking the user first -- normally Windows will prevent this from happening whenever you request to save a file with a name that already exists. Don't you get a dialog from Windows saying "The file Pre-Plan Template.vst already exists. Would you like to replace the existing file?" If so, at least this gives the user the choice. Other than that, I'm back to where I started, you could alter the filename by doing something as simple as adding a number or today's date (or current time) to the filename.
0
 

Author Comment

by:ChesterfieldFire
Comment Utility
Thanks for the code it works great!

I do not understand why the user is not prompted that the file already exists.  I am trying to write an if statement to prevent the overwriting, but I am not having much luck.
0
 
LVL 30

Expert Comment

by:Scott Helmers
Comment Utility
Do you still need assistance with this problem? If so, please let me know. If not, I would appreciate it if you would accept the answer and award the points.

Thanks,
Scott
0
 

Author Closing Comment

by:ChesterfieldFire
Comment Utility
Thanks, sorry for the delay in awarding your points.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Meetings to discuss business process can waste time, and often do .  The meeting's dialog can get confusing when participants have different professional perspectives and backgrounds.  A jointly-developed process picture helps wade through the confu…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now