Solved

Visio Template opened from Excel Userform

Posted on 2007-11-26
4
1,607 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
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 create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

739 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