Solved

Visio Template opened from Excel Userform

Posted on 2007-11-26
4
1,593 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
ID: 20374398
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
ID: 20403245
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
ID: 20503020
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
ID: 31410970
Thanks, sorry for the delay in awarding your points.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

920 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