Solved

Visio Template opened from Excel Userform

Posted on 2007-11-26
4
1,597 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

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

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

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

778 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