code to save a workbook and add a hyperlink to another works
MZ Tools makes life easier for the Excel VBA coder
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: code to save a workbook and add a hyperlink to another works

  1. #1
    Board Regular
    Join Date
    Apr 2002
    Location
    Manchester UK
    Posts
    133
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    I want a macro to save a workSHEET(eg sheet1) as a seperate workBOOK and have it give the book a name from cell A1 i also want it to add a macro to the worksheet(eg sheet2) of the open workbook, and if atall possible next to the cell that has the same value as that was in cell A1 (also what the file is now called)

  2. #2
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi jamienwood.
    That is easily doable. Just a question?
    What is the path to save the new workbook or do you want a save as dialog to popup so the user can specify a path?
    Tom

  3. #3
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Christchurch New Zealand
    Posts
    1,030
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    you want something like this
    Sub Macro1()

    '
    Dim bookname
    bookname = InputBox("Enter New Book Name")

    Sheets("sheet1").Select
    Sheets("sheet1").Copy
    ActiveWorkbook.SaveAs Filename:="C:" & (Book1) & ".xls", FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    Windows("original book.xls").Activate
    Range("a2").Select
    bookname = ActiveCell.Value
    End Sub


    [ This Message was edited by: brettvba on 2002-04-15 13:52 ]

  4. #4
    Board Regular
    Join Date
    Apr 2002
    Location
    Manchester UK
    Posts
    133
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-04-15 13:48, TsTom wrote:
    Hi jamienwood.
    That is easily doable. Just a question?
    What is the path to save the new workbook or do you want a save as dialog to popup so the user can specify a path?
    Tom
    I sorta have most of the code its a bit messy but here it is its mainly the hyperlink that i need, here goesRange("B6:I26").Select
    Selection.Copy
    Workbooks.Add
    Range("B6").Select
    ActiveSheet.Paste
    Columns("B:B").ColumnWidth = 8.57
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 8.29
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("F:F").ColumnWidth = 31.43
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").ColumnWidth = 12.43
    Rows("20:20").RowHeight = 15
    Rows("20:20").RowHeight = 15.75
    Rows("24:24").RowHeight = 19.5
    Range("C2:F2").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .MergeCells = False
    End With
    Selection.Merge
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    ActiveCell.FormulaR1C1 = "Customer Quote"
    Range("C3").Select
    ActiveWindow.DisplayGridlines = False
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Quote"
    Range("B6:I26").Select
    Selection.Interior.ColorIndex = xlNone
    Range("G26:I26").Select
    Selection.Font.ColorIndex = 2
    ThisFile2002 = Range("B7").Value
    ActiveWorkbook.SaveAs Filename:=ThisFile2002
    ActiveWorkbook.Close
    Application.Run "Quote_Print"

    What it is i have designed a qoute system and the qoute is on one worksheet and on the next is a customer database the quote is currently saved as the customers reference no. i then want a hyperlink on the customer database to open the just saved file.
    I also would like a current data to be added(of when the quote was made) and then a daily updated one so you can see the quote will expire in 30 days 29, 28 so on.


  5. #5
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Christchurch New Zealand
    Posts
    1,030
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    try this for the hyper link
    Sub Macro1()

    '
    Dim bookname
    bookname = InputBox("Enter New Book Name")
    bookname
    Sheets("sheet1").Select
    Sheets("sheet1").Copy
    ActiveWorkbook.SaveAs Filename:="C:" & (Book1) & ".xls", FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    Windows("original book.xls").Activate
    Range("a2").Select
    ' Hyper Link
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:" & (bookname) & ".xls", _
    TextToDisplay:=(bookname)
    End Sub

    Only one backslash tho some how this forum displays 2

    [ This Message was edited by: brettvba on 2002-04-15 14:14 ]

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com